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

Question

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

这样的事情，但我从来没有做过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("InboxmySubFolder1mySubFolder2")
  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:myFoldertest.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

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

Note 此示例正在使用过滤，还可以使用.GetDefaultFolder(olFolderTasks)获取用于日历项目的内置文件夹。例如，如果要访问收件箱，请使用olFolderInbox。

Answer 2

格式为：

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

在评论中建议的"将下一项行移动到programexit标签之前"

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