Specify folder and date range to get data from Outlook

[ricciolo]

Hi,

I have code for a macro so that I could get data from Outlook.

Option Explicit

Dim arrData() As Variant
Dim Cnt As Long


Sub test()


    Dim olApp As Object
    Dim olNS As Object
    Dim olFldr As Object
    
    Set olApp = CreateObject("Outlook.Application")
    
    Set olNS = olApp.GetNamespace("MAPI")
    
    Set olFldr = olNS.GetDefaultFolder(5) '5=olSentMail
    
    Cnt = 0
    
    Call RecursiveFolders(olFldr)
    
    Cells.ClearContents
    
    With ActiveSheet.Range("a1").Resize(, 5)
        .Value = Array("Folder", "To", "Subject", "Importance", "Sent")
        .Font.Bold = True
    End With
    
    ActiveSheet.Range("A2").Resize(UBound(arrData, 2), UBound(arrData, 1)).Value = WorksheetFunction.Transpose(arrData)
    
    ActiveSheet.Range("E2", Range("E2").End(xlDown)).NumberFormat = "mm/dd/yyyy h:mm AM/PM"
    
    ActiveSheet.Columns.AutoFit
    
End Sub


Sub RecursiveFolders(olFolder As Object)


    Dim olSubFolder As Object
    Dim olMail As Object


    For Each olMail In olFolder.Items
        Cnt = Cnt + 1
        ReDim Preserve arrData(1 To 5, 1 To Cnt)
        arrData(1, Cnt) = olFolder.FolderPath
        arrData(2, Cnt) = olMail.To
        arrData(3, Cnt) = olMail.Subject
        arrData(4, Cnt) = olMail.Importance
        arrData(5, Cnt) = olMail.SentOn
    Next
    
    For Each olSubFolder In olFolder.Folders
        Call RecursiveFolders(olSubFolder)
    Next olSubFolder
    
End Sub

I can hardcode where I get the data from with:

Set olFldr = olNS.GetDefaultFolder(5) '5=olFolderSentMail, 6=olFolderInbox

However, I was wondering if it was possible to make some kind of button or form so that I can select a folder (Inbox, Sent Items, Archive, etc.) and to select a date range (e.g., if I wanted to see the info for the emails I sent during the last two weeks instead of ALL the emails in the Sent Items folder).

Would it be easier to do this as a macro from Outlook (export data to Excel) vs. a macro in Excel (import data from Outlook)?

Thanks!

 

[tweedle]

Possibly incorporate olNS.PickFolder

 

[ricciolo]

I was able to incorporate olNS.PickFolder; however, is it possible to make some kind of form so that I can select to the folder and the date range? How would you go about doing this? Sorry; I'm not too familiar with VBA and was able to write the code in my first post by editing other code that I found by Googling, etc.

Thanks!

 

[ricciolo]

Also, it seems like the macro isn't picking up the most recent items on my Outbox and I'm not sure why.

 

[tweedle]

So for the two requested mods, they can both be dialogues; forms, in and of themselves.

You've incorporated the olNS.Pickfolder dialogue to get the top level (starting) folder.
To get the date, Application.InputBox can be used for prompting.
A module-level variable is set to make it available to the different functions.
That variable is then compared with each MailItem.SentOn date.
See below.

HTH

Option Explicit


Dim arrData() As Variant
Dim Cnt As Long
[COLOR=#0000cd]Dim inpSinceDate$, SinceDate As Date[/COLOR]


Sub test()




    Dim olApp As Object
    Dim olNS As Object
    Dim olFldr As Object
    
    Set olApp = CreateObject("Outlook.Application")
    
    Set olNS = olApp.GetNamespace("MAPI")
    
[COLOR=#0000CD]    Set olFldr = olNS.PickFolder[/COLOR]
[COLOR=#0000cd]    inpSinceDate$ = Application.InputBox("Export items with sent date since: ", "Export", Type:=2)[/COLOR]
[COLOR=#0000cd]    SinceDate = DateValue(inpSinceDate$)[/COLOR]
    
    Cnt = 0
    
    Call RecursiveFolders(olFldr)
    
    Cells.ClearContents
    
    With ActiveSheet.Range("a1").Resize(, 5)
        .Value = Array("Folder", "To", "Subject", "Importance", "Sent")
        .Font.Bold = True
    End With
    
    ActiveSheet.Range("A2").Resize(UBound(arrData, 2), UBound(arrData, 1)).Value = WorksheetFunction.Transpose(arrData)
    
    ActiveSheet.Range("E2", Range("E2").End(xlDown)).NumberFormat = "mm/dd/yyyy h:mm AM/PM"
    
    ActiveSheet.Columns.AutoFit
    
End Sub




Sub RecursiveFolders(olFolder As Object)




    Dim olSubFolder As Object
    Dim olMail As Object




    For Each olMail In olFolder.Items
[COLOR=#0000cd]        If olMail.SentOn >= SinceDate Then[/COLOR]
            Cnt = Cnt + 1
            ReDim Preserve arrData(1 To 5, 1 To Cnt)
            arrData(1, Cnt) = olFolder.FolderPath
            arrData(2, Cnt) = olMail.To
            arrData(3, Cnt) = olMail.Subject
            arrData(4, Cnt) = olMail.Importance
            arrData(5, Cnt) = olMail.SentOn
[COLOR=#0000cd]        End If[/COLOR]
    Next
    
    For Each olSubFolder In olFolder.Folders
        Call RecursiveFolders(olSubFolder)
    Next olSubFolder
    
End Sub

 

[ricciolo]

Instead of entering the date in the input box, is there a way to get some kind of calendar so that I can select the day? Or can there be two combo boxes? Combo box #1 has "30 days before", "14 days before", "7 days before", and "Select date" as options and combo box #2 has "Today" and "Select date". Together I can use them to make a range where combo box #1 is "From:" and combo box #2 is "To:". If the user chooses "Select date", there's some kind of calendar so that he/she can choose the dates he/she wants. I tried looking for how to insert a calendar on a userform, but apparently that's not available in Excel 2010 (which is what I'm using)?

Also, I was able to figure out how to add combo boxes to the userform, but I couldn't figure out how to add options to the combo boxes and how to link that to the VBA code.

Thanks so much!

 

[tweedle]

Instead of entering the date in the input box, is there a way to get some kind of calendar so that I can select the day?
Or can there be two combo boxes?
Combo box #1 has "30 days before", "14 days before", "7 days before", and "Select date" as options and combo box #2 has "Today" and "Select date".
Together I can use them to make a range where combo box #1 is "From:" and combo box #2 is "To:".
If the user chooses "Select date", there's some kind of calendar so that he/she can choose the dates he/she wants.
I tried looking for how to insert a calendar on a userform, but apparently that's not available in Excel 2010 (which is what I'm using)?

To get a calendar control available, in your form design panel, you should have a toolbox pane.
Right Click on that select "Additional Controls"
In the list should be "Calendar Control" with some version number after it.
Check the checkbox and click Ok
A calendar control should now be available in your toolbox to pull onto the userform.

Also, I was able to figure out how to add combo boxes to the userform, but I couldn't figure out how to add options to the combo boxes and how to link that to the VBA code.

To Add items to a ComboBox with code you would do something like this.

Private Sub UserForm_Initialize()


With ComboBox1
    .AddItem "Select One"
    .AddItem "30 days before"
    .AddItem "14 days before"
    .AddItem "7 days before"
    .AddItem "Select Date"
End With


With ComboBox2
    .AddItem "Select One"
    .AddItem "Today"
    .AddItem "Select Date"
End With

To read the user selection, you would do something like this:

Private Sub ComboBox1_Change()
Select Case ComboBox1.ListIndex
    Case Is = 0
        'Do Nothing
    Case Is = 1
        MsgBox "User wants " & ComboBox1.Value, vbOKOnly, "Example"
    Case Is = 2
        MsgBox "User wants " & ComboBox1.Value, vbOKOnly, "Example"
    Case Is = 3
        MsgBox "User wants " & ComboBox1.Value, vbOKOnly, "Example"
    Case Is = 4
        MsgBox "User wants " & ComboBox1.Value, vbOKOnly, "Example"

End Select
End Sub

 

[ricciolo]

In the list should be "Calendar Control" with some version number after it.
Check the checkbox and click Ok

Hm, I don't see this. I saw Microsoft Outlook Date Control but I found out that this can't be used in a Userform. Thanks for the combo-box help.

(Also, I x-posted in other forums: Get emails within specific time period from Outlook and Select folder and date range to get emails from Outlook. I apologize if it was discourteous; I didn't completely read the forum rules before. Plus, since I'm not very familiar with VBA, I was trying to find a solution ASAP. I hope you're not offended, and I truly appreciate your help, @tweedle!)

 

[ricciolo]

Okay, I decided to not use a calendar because I couldn't figure it out. Instead I used a combination of comboboxes and textboxes.

In my Userform code, I have two variables - sinceDate and fromDate - from the textboxes that I want to pass into a procedure in a module. When I call the procedure, I pass them like this:

Call getOutlookInfo(fromDate, toDate)

So I changed my code in the module to look like:

Sub getOutlookInfo(fromDt As Date, toDt As Date)

Before it was:

Sub getOutlookInfo()

However, I can't run the macro anymore. When I press "Run", there's no macro to process. The code was able to compile. Is there any issue with how I passed the variable?

Also, getOutlookInfo() is test() in the code I first posted.

 

[ricciolo]

Okay, I think I see the issue. Maybe it's because I'm trying to run the code in module, which requires an input, but I can't run JUST the code without inputs?

getOutlookInfo() is called when a button in the userform is clicked. When I click the button, the macro gets to getOutlookInfo() but I get an error saying that an Object is required at the following line:

Set sinceDt = fromDt

This is my code for getOutlookInfo():

Option Explicit

Dim arrData() As Variant
Dim Cnt As Long
Dim txtSender As String
Dim txtTime As String
Dim sinceDt, toDt As Date


Sub getOutlookInfo(fromDt As Date, toDt As Date)
    Dim olApp As Object
    Dim olNS As Object
    Dim olFldr As Object
    
    Set olApp = CreateObject("Outlook.Application")
    
    Set olNS = olApp.GetNamespace("MAPI")
    
    Set olFldr = olNS.PickFolder
    'Set olFldr = olNS.GetDefaultFolder(6)
    
    Set sinceDt = fromDt
    Set untilDt = toDt
    
    Cnt = 0
    
    If olFldr Is Nothing Then
        Exit Sub
    End If
    
    Call RecursiveFolders(olFldr)
    
    Cells.ClearContents
    
    Select Case olFldr
        Case "Inbox"
            txtSender = "From"
            txtTime = "Received"
        Case "Sent Items"
            txtSender = "To"
            txtTime = "Sent On"
        Case Else
            txtSender = "To/From"
            txtTime = "Received"
    End Select
   
    With ActiveSheet.Range("a1").Resize(, 5)
        .Value = Array("Folder", txtSender, "Subject", "Importance", txtTime)
        .Font.Bold = True
    End With
    
    ActiveSheet.Range("A2").Resize(UBound(arrData, 2), UBound(arrData, 1)).Value = WorksheetFunction.Transpose(arrData)
    
    ActiveSheet.Range("E2", Range("E2").End(xlDown)).NumberFormat = "mm/dd/yyyy h:mm AM/PM"
    
    ActiveSheet.Columns.AutoFit
    
End Sub


Sub RecursiveFolders(olFolder As Object)
    Dim olSubFolder As Object
    Dim olMail As Object
    
    For Each olMail In olFolder.Items
        If TypeOf olMail Is MailItem Then
            If olMail.SentOn >= sinceDt And olMail.SentOn <= untilDt Then
            
                Cnt = Cnt + 1
            
                ReDim Preserve arrData(1 To 5, 1 To Cnt)
                arrData(1, Cnt) = olFolder.FolderPath
                arrData(3, Cnt) = olMail.Subject
                arrData(4, Cnt) = olMail.Importance
            
                Select Case olFolder
                Case "Sent Items"
                    arrData(2, Cnt) = olMail.To
                    arrData(5, Cnt) = olMail.SentOn
                Case Else
                    arrData(2, Cnt) = olMail.Sender
                    arrData(5, Cnt) = olMail.ReceivedTime
                End Select
            End If
        End If
    Next
    
    For Each olSubFolder In olFolder.Folders
        Call RecursiveFolders(olSubFolder)
    Next olSubFolder
    
End Sub

Sorry for so many posts...