Outlook 访问共享收件箱子文件夹

Question

我用于将 Outlook 电子邮件信息提取到 Excel 中的以下代码有一个奇怪的问题。 有时代码运行良好，但有时我会收到运行时错误'-2147221233 (8004010f)' 。 当我收到此错误时，出现问题的是Set objFolder = objMailbox.Folders("Inbox").Folders("ARCHIVE") 。

我在共享收件箱上运行代码，并且将“ARCHIVE”文件夹作为收件箱的子文件夹。 就好像代码找不到文件夹，即使它在那里，有时也能找到。

我没有受过教育的猜测是，由于共享收件箱可能会延迟所有用户的更新，如果文件夹中有任何操作，则代码无法识别该文件夹，直到它在服务器上刷新或更新。

有人可以建议略有不同的代码，以便每次都能运行吗？ 或者有没有人解释为什么它只是偶尔按原样工作？

Sub EmailStatsV3()
'Working macro for exporting specific sub-folders of a shared inbox
Dim olMail As Variant
Dim aOutput() As Variant
Dim lCnt As Long
Dim xlApp As Excel.Application
Dim xlSh As Excel.Worksheet
Dim flInbox As Folder

'Gets the mailbox and shared folder inbox
Dim myNamespace As Outlook.NameSpace
Dim myRecipient As Outlook.Recipient
Set myNamespace = Application.GetNamespace("MAPI")
Set myRecipient = myNamespace.CreateRecipient("Operations") 

Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objInbox = objNamespace.GetSharedDefaultFolder(myRecipient, olFolderInbox)

'Uses the Parent of the Inbox to specify the mailbox
strFolderName = objInbox.Parent

'Specifies the folder (inbox or other) to pull the info from
Set objMailbox = objNamespace.Folders(strFolderName)
Set objFolder = objMailbox.Folders("Inbox").Folders("ARCHIVE") 'Change this line to specify folder
Set colItems = objFolder.Items

'Specify which email items to extract
ReDim aOutput(1 To objFolder.Items.Count, 1 To 10)
For Each olMail In objFolder.Items
If TypeName(olMail) = "MailItem" Then

        lCnt = lCnt + 1
        aOutput(lCnt, 1) = olMail.SenderEmailAddress 'Sender or SenderName also gives similar output
        aOutput(lCnt, 2) = olMail.ReceivedTime 'stats on when received
        aOutput(lCnt, 3) = olMail.ConversationTopic 'group based on subject w/o regard to prefix
        aOutput(lCnt, 4) = olMail.Subject 'to split out prefix
        aOutput(lCnt, 5) = olMail.Categories 'to split out category
        aOutput(lCnt, 6) = olMail.Sender
        aOutput(lCnt, 7) = olMail.SenderName
        aOutput(lCnt, 8) = olMail.To
        aOutput(lCnt, 9) = olMail.CC
        aOutput(lCnt, 10) = objFolder.Name
End If

Next

'Creates a blank workbook in excel then inputs the info from Outlook
Set xlApp = New Excel.Application
Set xlSh = xlApp.Workbooks.Add.Sheets(1)

xlSh.Range("A1").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput
xlApp.Visible = True


End Sub

Answer 1

我假设您正在从 Outlook 运行代码，请参阅我所做的清理工作。

Option Explicit
Sub EmailStatsV3()
    Dim Item As Object
    Dim varOutput() As Variant
    Dim lngcount As Long
    Dim xlApp As Excel.Application
    Dim xlSht As Excel.Worksheet
    Dim ShareInbox As Outlook.MAPIFolder
    Dim olNs As Outlook.NameSpace
    Dim olRecip As Outlook.Recipient
    Dim SubFolder As Object

    Set olNs = Application.GetNamespace("MAPI")
    Set olRecip = olNs.CreateRecipient("0m3r@Email.com") '// Owner's Name or email address
    Set ShareInbox = olNs.GetSharedDefaultFolder(olRecip, olFolderInbox)
    Set SubFolder = ShareInbox.Folders("Temp") 'Change this line to specify folder

    ReDim varOutput(1 To SubFolder.Items.Count, 1 To 10)

    For Each Item In SubFolder.Items
        If TypeName(Item) = "MailItem" Then
            lngcount = lngcount + 1
            varOutput(lngcount, 1) = Item.SenderEmailAddress 'Sender or SenderName
            varOutput(lngcount, 2) = Item.ReceivedTime 'stats on when received
            varOutput(lngcount, 3) = Item.ConversationTopic 'Conversation subject
            varOutput(lngcount, 4) = Item.Subject 'to split out prefix
            varOutput(lngcount, 5) = Item.Categories 'to split out category
            varOutput(lngcount, 6) = Item.Sender
            varOutput(lngcount, 7) = Item.SenderName
            varOutput(lngcount, 8) = Item.To
            varOutput(lngcount, 9) = Item.CC
            varOutput(lngcount, 10) = SubFolder.Name
        End If
    Next

    'Creates a blank workbook in excel
    Set xlApp = New Excel.Application
    Set xlSht = xlApp.Workbooks.Add.Sheets(1)

    xlSht.Range("A1").Resize(UBound(varOutput, 1), _
                             UBound(varOutput, 2)).Value = varOutput
    xlApp.Visible = True

End Sub