How to count all the emails from every folder and subfolder of a shared email in outlook using VBA?

Question

There is a shared inbox in my Outlook and I would like to count all the emails in every folder and subfolder of this shared inbox.

So far I have this code which gives a count of one subfolder at a time. But I need the count of all the subfolders which consist of any email at one time.

    Sub HowManyEmails()

    Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder
    Dim EmailCount As Integer
    Set objOutlook = CreateObject("Outlook.Application")
    Set objnSpace = objOutlook.GetNamespace("MAPI")

    On Error Resume Next
    Set objFolder = Application.Session.PickFolder
    If Err.Number <> 0 Then
        Err.Clear
        MsgBox "No such folder."
        Exit Sub
    End If

    EmailCount = objFolder.Items.Count

    MsgBox "Number of emails in the folder: " & EmailCount, , "email count"

    Dim dateStr As String
    Dim myItems As Outlook.Items
    Dim dict As Object
    Dim msg As String
    Set dict = CreateObject("Scripting.Dictionary")
    Set myItems = objFolder.Items
    myItems.SetColumns ("SentOn")
    ' Determine date of each message:
    For Each myItem In myItems
        dateStr = GetDate(myItem.SentOn)
        If Not dict.Exists(dateStr) Then
            dict(dateStr) = 0
        End If
        dict(dateStr) = CLng(dict(dateStr)) + 1
    Next myItem

    ' Output counts per day:
    msg = ""
    For Each o In dict.Keys
        msg = msg & o & ": " & dict(o) & " items" & vbCrLf
    Next
    MsgBox msg

    Set objFolder = Nothing
    Set objnSpace = Nothing
    Set objOutlook = Nothing
End Sub

Function GetDate(dt As Date) As String
    GetDate = Year(dt) & "-" & Month(dt) & "-" & Day(dt) & "-"
End Function

Answer 1

You need to iterate over folders tree recursively to get the numbers, for example, here is the skeleton for that:

Private Sub processFolder(ByVal oParent As Outlook.MAPIFolder)

        Dim oFolder As Outlook.MAPIFolder
        Dim oMail As Outlook.MailItem

        Debug.Print(oParent.Items.Count)    

        For Each oMail In oParent.Items

        'Get your data here ...

        Next

        If (oParent.Folders.Count > 0) Then
            For Each oFolder In oParent.Folders
                processFolder oFolder
            Next
        End If
End Sub

See How to count emails from various folders and subfolders of Outlook using vba?.