在特定的Outlook文件夹中迭代所有电子邮件项目

Question

如何在Outlook VBA宏中迭代特定Outlook文件夹中的所有电子邮件项（在这种情况下，该文件夹不属于我的个人收件箱，而是共享邮箱收件箱的子文件夹）。

像这样的东西，但我从未编写过Outlook宏...

For each email item in mailboxX.inbox.mySubfolder.items
// do this
next item

我尝试了这个方法，但收件箱的子文件夹未被找到...

Private Sub Application_Startup()

Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Set objNS = GetNamespace("MAPI")
Set objFolder = objNS.Folders("myGroupMailbox")
Set objFolder = objFolder.Folders("Inbox\mySubFolder1\mySubFolder2")

  On Error GoTo ErrorHandler
  Dim Msg As Outlook.MailItem

For Each Item In objFolder.Items

  If TypeName(Item) = "MailItem" Then

    Set Msg = Item
    If new_msg.Subject Like "*myString*" Then
        strBody = myItem.Body
        Dim filePath As String
        filePath = "C:\myFolder\test.txt"
        Open filePath For Output As #2
        Write #2, strBody
        Close #2

    End If

  End If

ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.Number & " - " & Err.Description
  Resume ProgramExit

Next Item

End Sub

- user3271332

---

你遇到的问题是哪一部分呢？是“如何选择正确的子文件夹”吗？ - Floris

是的，但我从未编写过Outlook宏，只想用一些简单的操作迭代这个文件夹，但我找到的示例似乎相当复杂。我需要添加其他内容来运行循环吗？ - user3271332

你是收到错误信息还是找不到你知道存在的东西？无论哪种情况，我认为你应该将 next item 行移到 ProgramExit 标签之前，目前你会在到达它之前退出子程序。 - Graham Anderson

Answer 1

在我的情况下，以下方法有效：

Sub ListMailsInFolder()

    Dim objNS As Outlook.NameSpace
    Dim objFolder As Outlook.MAPIFolder

    Set objNS = GetNamespace("MAPI")
    Set objFolder = objNS.Folders.GetFirst ' folders of your current account
    Set objFolder = objFolder.Folders("Foldername").Folders("Subfoldername")

    For Each Item In objFolder.Items
        If TypeName(Item) = "MailItem" Then
            ' ... do stuff here ...
            Debug.Print Item.ConversationTopic
        End If
    Next

End Sub

同样地，您也可以遍历日历项：

Private Sub ListCalendarItems()
        Set olApp = CreateObject("Outlook.Application")
        Set olNS = olApp.GetNamespace("MAPI")

        Set olRecItems = olNS.GetDefaultFolder(olFolderTasks)
        strFilter = "[DueDate] > '1/15/2009'"
        Set olFilterRecItems = olRecItems.Items.Restrict(strFilter)
        For Each Item In olFilterRecItems
        If TypeName(Item) = "TaskItem" Then
            Debug.Print Item.ConversationTopic
        End If
    Next
End Sub

请注意，此示例使用了筛选器和.GetDefaultFolder(olFolderTasks)来获取日历项的内置文件夹。如果您想要访问收件箱，例如，请使用olFolderInbox。

- Matt

Answer 2

格式为：

Set objFolder = objFolder.Folders("Inbox").Folders("mySubFolder1").Folders("mySubFolder2")

根据评论建议，“将下一个项目行移动到ProgramExit标签之前”。

- niton

Answer 3

Sub TheSub()

Dim objNS As Outlook.NameSpace
Dim fldrImAfter As Outlook.Folder
Dim Message As Outlook.MailItem

    'This gets a handle on your mailbox
    Set objNS = GetNamespace("MAPI")

    'Calls fldrGetFolder function to return desired folder object
    Set fldrImAfter = fldrGetFolder("Folder Name Here", objNS.Folders)

    For Each Message In fldrImAfter.Items
        MsgBox Message.Subject
    Next

End Sub

递归函数用于循环遍历所有文件夹，直到找到指定的文件夹名称为止....

Function fldrGetFolder( _
                    strFolderName As String _
                    , objParentFolderCollection As Outlook.Folders _
                    ) As Outlook.Folder

Dim fldrSubFolder As Outlook.Folder

    For Each fldrGetFolder In objParentFolderCollection

        'MsgBox fldrGetFolder.Name

        If fldrGetFolder.Name = strFolderName Then
            Exit For
        End If

        If fldrGetFolder.Folders.Count > 0 Then
            Set fldrSubFolder = fldrGetFolder(strFolderName, 
fldrGetFolder.Folders)
            If Not fldrSubFolder Is Nothing Then
                Set fldrGetFolder = fldrSubFolder
                Exit For
            End If
        End If

    Next

End Function

- DonkeyKong