Loop through all outlook items, find emails with email bodies containing a certain text

Question

We have a project at work and basically it should do the following:

1. Loop through all Outlook items (main email account and its sub folders)
2. Loop through all Outlook items (user created Data Files (PST files) and its sub folders)
3. The two loops above should exclude the Yammer Root, Sync Issues, Contacts, and Calendar folders
4. Find emails with email bodies that contain a certain text (e.g. XXX-YY-2020777), this is for me the most important code
5. Print these in the worksheet:
   • main folder - sub folder
   • sender
   • email subject
   • date received

So I found a post useful here, credits to 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

I can combine these two posts:

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

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

But I need some guidance so I can start this.

Answer 1

I started with

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

Do I have to insert this in every FOR EACH loop (main folder, subfolder1, subfolder2, subfolder3, and so on and so forth... ?

                    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