L oop через все элементы внешнего вида, найти электронные письма с телами электронной почты, содержащими определенный текст

Question

У нас есть проект на работе, и в основном он должен делать следующее:

1. L oop через все элементы Outlook (основной почтовый ящик и его подпапки)
2. L oop через все элементы Outlook (созданные пользователем файлы данных (PST-файлы) и его подпапки)
3. Два вышеуказанных цикла должны исключать папки Yammer Root, Syn c Issues, Contacts и Calendar
4. Поиск электронных писем с телами электронной почты, которые содержат определенный текст (например, XXX-YY-2020777), для меня это самый важный код
5. Распечатайте их на листе:
   • основная папка - подпапка
   • отправитель
   • тема письма
   • дата получения

Так что я нашел сообщение полезным вот, кредиты Кита Вейтлинга:

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 : Перебирая все подпапки в электронной почте Outlook, чтобы найти письмо с определенной темой

Но мне нужны некоторые рекомендации так что я могу начать это.

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 l oop (основная папка, подпапка 1, подпапка 2, подпапка 3 и т. Д. И т. Д. И т. Д.??

                    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