Question

我目前有一个代码，我认为应该只从默认文件夹中提取指定的所有邮件。

它没有像我预期的那样工作。我知道从root用户循环共享邮箱中的所有文件夹存在一些问题。怎么解决它？

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

Answer 1

请记住，默认情况下，Outlook会在主邮箱的OST文件中缓存共享文件夹。子文件夹不会被缓存。尝试在Exchange帐户属性对话框中禁用共享文件夹缓存。

EXCEL VBA代码，用于从根文件夹到子文件夹检索所有邮件的sharedmailbox

1 个答案: