vba count emails per day including sub folders

[VeryForgetful]

Hi,

I have the code below that outputs the email count per day for a generic team inbox, in this example the inbox is named genericqueries.

I am looking for a way to also count the emails in sub folders within this inbox.

Also, this email address contains roughly 8000 emails and it takes an eternity to output the results to a worksheet. Would there be an alternative way to accomplish this quicker than storing the results in a dictionary?

Thanks

Sub EmailCount()


    Dim ns As Outlook.Namespace
    Dim f As Outlook.MAPIFolder
    Dim dateStr As String
    Dim myItems As Outlook.Items
    Dim dict As Object
    Dim msg As String
    Dim NextRow As Long
    Dim FirstRow As Long
    Dim SrcSheet As Worksheet
    
 
    Set SrcSheet = Sheets("Email Summary")
    Set ns = Outlook.GetNamespace("MAPI")


    On Error Resume Next


    Set f = ns.Folders("genericqueries").Folders("Inbox")   'also include sub folders
     If Err.Number <> 0 Then
        Err.Clear
        MsgBox "No such folder.", vbExclamation
        Exit Sub
    End If


    Set dict = CreateObject("Scripting.Dictionary")
    Set myItems = f.Items


    myItems.Sort "[SentOn]", True
    myItems.SetColumns "[SentOn]"


    FirstRow = 2
    SrcSheet.Rows(FirstRow & ":" & SrcSheet.Rows.Count).Clear
   
    For Each myItem In myItems
        dateStr = Format(myItem.SentOn, "yyyy-mm-dd")
        If Not dict.Exists(dateStr) Then
            dict(dateStr) = 0
        End If
        dict(dateStr) = CLng(dict(dateStr)) + 1
    Next myItem


    ' Output dates that have emails
    For Each o In dict.Keys
        NextRow = SrcSheet.Range("C" & Rows.Count).End(xlUp).Row + 1
        msg = o
        Application.StatusBar = msg
        SrcSheet.Range("C" & NextRow) = msg
    Next


    ' Output email count per day:
    For Each o In dict.Keys
        NextRow = SrcSheet.Range("D" & Rows.Count).End(xlUp).Row + 1
        msg = dict(o)
        Application.StatusBar = msg
        SrcSheet.Range("D" & NextRow) = msg
    Next


End Sub

 

[Eric W]

I haven't worked much with Outlook from VBA, but I don't see much that I could improve. However, your routine where you write out the contents of your dictionary is really slow!

Change this section:

' Output dates that have emails
    For Each o In dict.Keys
        NextRow = SrcSheet.Range("C" & Rows.Count).End(xlUp).Row + 1
        msg = o
        Application.StatusBar = msg
        SrcSheet.Range("C" & NextRow) = msg
    Next


    ' Output email count per day:
    For Each o In dict.Keys
        NextRow = SrcSheet.Range("D" & Rows.Count).End(xlUp).Row + 1
        msg = dict(o)
        Application.StatusBar = msg
        SrcSheet.Range("D" & NextRow) = msg
    Next

to

    Set NextCell = SrcSheet.Cells(Rows.Count, "C").End(xlUp).Offset(1)
    NextCell.Resize(dict.Count) = WorksheetFunction.Transpose(dict.keys)
    NextCell.Offset(, 1).Resize(dict.Count) = WorksheetFunction.Transpose(dict.items)

This should work fine, as long as the number of items in your dictionary is below 32K. Transpose has a 32K limit. Let us know if this helps.

 

[VeryForgetful]

Thanks, will try this and let you know. Any idea reference my other issue of including sub folders in the count without having to manually define each folder?

 

[John_w]

I am looking for a way to also count the emails in sub folders within this inbox.

Try incorporating the code at https://www.mrexcel.com/forum/excel-questions/688228-outlook-folder-structure.html - the Process_Folder2 function, which recursively loops through subfolders, though I would change the two "As Integer" declarations to "As Long".

 

[Eric W]

As I said, I haven't done much with Outlook, so I don't know the object model well. This link:

https://stackoverflow.com/questions/8697493/update-excel-sheet-based-on-outlook-mail/8699250#8699250

particularly the AnswerB part, shows an example of how to reference second level folders. It shouldn't be too hard to have a loop inside your main loop to look for additional folders. If you have folders within folders within folders, etc. that you want to check, you'd need some kind of a recursive routine. Trickier, but possible.

 

[VeryForgetful]

Hi, the modification you made to the dictionary code has increased the speed considerably, thanks for your help.

 

[vdspharma]

Hi , I am looking for the same exact code. Can you please share the final code ?