EXCEL VBA code to retrieve sharedmailbox all mails from root folders to subfolders

问题

I have a code currently which I think should pull all mail items specified from only default folder.

It's not working as I expected. I know there is some problem in looping all folders in shared mail box from root. How can fix it?

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Outlook.Namespace
Dim olShareName As Outlook.Recipient
Dim Folder As MAPIFolder
Dim eFolder As Outlook.Folder
Dim olItems As Outlook.Items
Dim OutlookMail As Variant
Dim arrResults() As Variant
Dim ItemCount As Long

Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set olShareName = OutlookNamespace.CreateRecipient("example@example.com")

For Each eFolder In OutlookNamespace.GetSharedDefaultFolder(olShareName, olFolderInbox).Folders

    Set Folder = OutlookNamespace.GetSharedDefaultFolder(olShareName, olFolderInbox).Folders(eFolder.Name)

    Set olItems = Folder.Items.Restrict("[ReceivedTime] >= '" & Range("From_date").Value & "' and [ReceivedTime] <= '" & Range("to_date").Value & "'")

    If olItems.Count > 0 Then
        ReDim arrResults(1 To olItems.Count, 1 To 5)
        ItemCount = 0
        For Each OutlookMail In olItems
            ItemCount = ItemCount + 1
            arrResults(ItemCount, 1) = OutlookMail.Subject
            arrResults(ItemCount, 2) = OutlookMail.ReceivedTime
            arrResults(ItemCount, 3) = OutlookMail.SenderName
            arrResults(ItemCount, 4) = OutlookMail.Size
            arrResults(ItemCount, 5) = OutlookMail.Categories
        Next OutlookMail
        Worksheets("import").Range("A5").Resize(UBound(arrResults, 1), 5) = arrResults
    Else
        MsgBox "No items found!", vbExclamation
    End If

    Set olItems = Nothing

    Set Folder = Nothing
    Set OutlookNamespace = Nothing
    Set olShareName = Nothing
    Set OutlookApp = Nothing
Next eFolder

回答1:

Keep in mind that by default Outlook caches shared folders in the primary mailbox's OST file. Subfolders are not cached. Try to disable the shared folder caching in the Exchange account properties dialog.

来源：https://stackoverflow.com/questions/49597851/excel-vba-code-to-retrieve-sharedmailbox-all-mails-from-root-folders-to-subfolde

标签

vba

excel-vba