VBA to count emails in subfolders of shared inbox within Outlook-CodePudding

`Hi Guys,

I want to count the number of emails in 8 different subfolders of a shared email in Outlook. I also want to find out the date of the last email in these folders.

The shared inbox looks like

>"Shared Inbox Name"
>>Inbox
>>>Folder one
>>>>A
>>>>B
>>>>C
>>>Folder two
>>>>D
>>>>E
>>>>F
>>>>G

I want the result to show number of emails of all these folders together and not one by one. A, B, C, D, E, F, G. And also the date of the last email in each folder.

So far I have managed to get this but it only shows the data for one folder at a time and nothing about the date as well.

Here is the code`

```Sub CountItems()
    Dim objMainFolder As Outlook.folder
    Dim lItemsCount As Long
 
    `Select a folder`
    Set objMainFolder = Outlook.Application.Session.PickFolder
 
    If objMainFolder Is Nothing Then
       MsgBox "You should select a valid folder!", vbExclamation   vbOKOnly, "Warning for Pick Folder"
    Else
       `Initialize the total count`
       lItemsCount = 0
       Call LoopFolders(objMainFolder, lItemsCount)
    End If
 
    `Display a message for the total count`

MsgBox "There are " & lItemsCount & " items in the " & objMainFolder.Name & " folder Including its subfolders.", vbInformation, "Count Items"
End Sub

Sub LoopFolders(ByVal objCurrentFolder As Outlook.folder, lCurrentItemsCount As Long)
    Dim objSubfolder As Outlook.folder
 
    lCurrentItemsCount = lCurrentItemsCount   objCurrentFolder.Items.count
 
    `Process all folders and subfolders recursively`
    If objCurrentFolder.Folders.count Then
       For Each objSubfolder In objCurrentFolder.Folders
           Call LoopFolders(objSubfolder, lCurrentItemsCount)
       Next
    End If
End Sub```

CodePudding user response：

You can use the following code to get the latest item:

Sub Sample()
    Dim objNS As NameSpace
    Dim objFolder As MAPIFolder
    Dim myItems As Items
    Dim myItem As MailItem

    Set objNS = GetNamespace("MAPI")
    Set objFolder = objNS.GetDefaultFolder(olFolderInbox)

    Set myItems = objFolder.Items
    myItems.Sort "ReceivedTime", True

    If myItems.Count > 0 Then
        Set myItem = myItems.Item(1)

        Debug.Print myItem.ReceivedTime
    Else
        Msgbox "This folder doesn't have any emails/items"
    End If
End Sub

CodePudding user response：

Firstly, lCurrentItemsCount parameter must be declared ByRef to make it an in/out parameter.

To get the date of the latest email, retrieve the Items collection from MAPIFolder.Items, call Items.Sort to sort of the ReceivedTime property, then call Items.GetFirst to get back the MailItem object. Use MailItem.ReceivedTime property.