共享收件箱 - 在 Outlook VBA 中跳过非邮件项目

Posted 2023-03-15

【中文标题】共享收件箱 - 在 Outlook VBA 中跳过非邮件项目

【英文标题】：Shared Inbox - Skipping non-mail items in Outlook VBA

【发布时间】：2015-12-20 20:44:28

【问题描述】：

我不是 Outlook VBA 方面的专家，但我设法创建了一些运行良好的宏。我已经在下面的代码上工作了一段时间，现在剩下一个小问题。该宏将每封电子邮件的信息从共享收件箱的子文件夹中导入到 Excel 文件中。我遇到的问题是当 for next 循环遇到非邮件项目（例如会议邀请或传递失败通知）时。代码在“下一个”行停止并在遇到这些非邮件项目时给出“类型不匹配”错误。再次按播放继续代码，直到遇到另一个非邮件项目。我想让代码跳过这些非邮件项目并遍历整个收件箱/文件夹。

我已经尝试过“On Error Resume Next”，但它似乎跳过了“Next”行并继续执行剩余的代码，而实际上没有循环回到“For Each”行。我玩过 If 和 GoTo 语句，但没有一个对我有用。有人可以帮忙吗？

总的来说，我还有另一个宏的问题。有时它不会运行，因为它似乎无法识别收件箱的“ARCHIVE”子文件夹，但有时它很好。我的猜测是，当共享收件箱与服务器同步时，或者类似的东西，“ARCHIVE”文件夹无法访问，但这只是一个猜测。如果有人能更深入地了解这个问题，我将不胜感激。

Sub EmailStatsV3()

Dim olMail As Outlook.MailItem
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("Shared Inbox") 'Change "Shared Inbox" to whatever shared inbox you use

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 5)
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
End If

Next olMail

'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

【问题讨论】：

哪一行会引发错误？

Macro Man 的以下回答完美。仅供参考，代码停在“下一个 olMail”行。

很高兴它正在工作。下一次，在你的 Q 中包含更多相关信息——通常期望提问者会识别出哪一行引发了错误:) 这样可以省去其他人不得不猜测问题可能是什么的麻烦。干杯。

【参考方案1】：

改变

Dim olMail As Outlook.MailItem

到

Dim olMail As Variant

---

Variant 类型应该用于在 For Each 循环中迭代集合，在您的示例中，Next 项目不是 MailItem - 这是 olMail 已声明的内容。您已经检查了olMail 是否为邮件项目，因此您可以在此处使用变体。

【讨论】：

感谢您的帮助。完美运行。