Excel VBA-遍历所有Outlook项目，查找带有包含特定文本的电子邮件正文的电子邮件

Question

所以我们有一个项目在工作，基本上它应该执行以下操作：

1. 循环浏览所有Outlook项目（主电子邮件帐户及其子文件夹）
2. 循环浏览所有Outlook项目（用户创建的数据文件（PST文件）及其子文件夹）
3. 以上两个循环应排除Yammer根目录，同步问题，联系人和日历文件夹
4. 查找包含某些文本（例如XXX-YY-2020777）的电子邮件正文的电子邮件，这对我来说是最重要的代码
5. 在工作表中打印这些：
   • 主文件夹-子文件夹
   • 发送者
   • 电子邮件主题
   • 收到日期

所以我发现这里的帖子很有用，感谢Keith Whatling：

Sub GetEmail()

Dim OutApp As Outlook.Application
Dim Namespace As Outlook.Namespace
Dim Mfolder As Outlook.MAPIFolder
Dim myMail As Outlook.Items

Dim Folder As Outlook.MAPIFolder
Dim SubFolder As Outlook.MAPIFolder
Dim UserFolder As Outlook.MAPIFolder

Set OutApp = New Outlook.Application
Set Namespace = OutApp.GetNamespace("MAPI")

On Error Resume Next
For Each Folder In Namespace.Folders
    For Each SubFolder In Folder.Folders
        For Each UserFolder In SubFolder.Folders
            Debug.Print Folder.Name, "|", SubFolder.Name, "|", UserFolder.Name
        Next UserFolder
    Next SubFolder
Next Folder
On Error GoTo 0

End Sub

我可以将这两篇文章合并：

https://www.encodedna.com/excel/how-to-parse-outlook-emails-and-show-in-excel-worksheet-using-vba.htm和

Excel vba: Looping through all subfolders in Outlook email to find an email with certain subject

但是无论如何，我需要你们的一些指导，以便我可以正确地开始。

谢谢。

XYZKLM

Answer 1

我开始是

Sub GetEmailTesting()

Dim outlook_app As Outlook.Application
Dim namespace As Outlook.namespace

Set outlook_app = New Outlook.Application
Set namespace = outlook_app.GetNamespace("MAPI")

Dim main_folder As Outlook.MAPIFolder
Dim sub_folder1 As Outlook.MAPIFolder
Dim sub_folder2 As Outlook.MAPIFolder
Dim sub_folder3 As Outlook.MAPIFolder

On Error Resume Next

For Each main_folder In namespace.Folders
    ' code goes here
     For Each sub_folder1 In main_folder.Folders
        ' code goes here
        For Each sub_folder2 In sub_folder1.Folders
            ' code goes here
            For Each sub_folder3 In sub_folder2.Folders
                    Dim rowNumber As Integer
                    rowNumber = 2
                    For Each obj_item In sub_folder3.Items
                        If obj_item.Class = olMail Then
                            Dim obj_mail As Outlook.MailItem
                            Set obj_mail = obj_item
                            Cells(rowNumber, 1) = obj_mail.SenderEmailAddress
                            Cells(rowNumber, 2) = obj_mail.To
                            Cells(rowNumber, 3) = obj_mail.Subject
                            Cells(rowNumber, 4) = obj_mail.ReceivedTime
                        End If
                        rowNumber = rowNumber + 1
                    Next
            Next sub_folder3
        Next sub_folder2
    Next sub_folder1
Next main_folder

On Error GoTo 0

End Sub

我是否必须在每个FOR EACH循环中插入它（主文件夹，subfolder1，subfolder2，subfolder3，依此类推，等等...？
                    For Each obj_item In sub_folder3.Items
                        If obj_item.Class = olMail Then
                            Dim obj_mail As Outlook.MailItem
                            Set obj_mail = obj_item
                            Cells(rowNumber, 1) = obj_mail.SenderEmailAddress
                            Cells(rowNumber, 2) = obj_mail.To
                            Cells(rowNumber, 3) = obj_mail.Subject
                            Cells(rowNumber, 4) = obj_mail.ReceivedTime
                        End If
                        rowNumber = rowNumber + 1
                    Next