VBA loop to extract a summary of last 30 days of emails

I'm trying to create VBA that:

• looks at my Outlook account
• looks in all folders
• for the last 30 days
• creates simple Excel summary of the email traffic showing simple fields (sender, date, email from, folder, etc)

Have created the below but it only pulls one folder and then exits.

I was expecting the code to loop through all folders in my Inbox but it didn't

Sub ExportEmailsToExcel()
    Dim outlookApp As Outlook.Application
    Dim outlookNamespace As Outlook.Namespace
    Dim folder As Outlook.MAPIFolder
    Dim subfolder As Outlook.MAPIFolder
    Dim item As Object
    Dim mailItem As Outlook.mailItem
    Dim xlApp As Object
    Dim xlWorkbook As Object
    Dim xlWorksheet As Object
    Dim row As Integer

    Set outlookApp = New Outlook.Application
    Set outlookNamespace = outlookApp.GetNamespace("MAPI")
    Set folder = outlookNamespace.Folders("example@outlook.com") 

    ' Create a new Excel workbook
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Set xlWorkbook = xlApp.Workbooks.Add
    Set xlWorksheet = xlWorkbook.Sheets(1)

    ' Set up the header row in Excel
    xlWorksheet.Cells(1, 1).Value = "Date Received"
    xlWorksheet.Cells(1, 2).Value = "From"
    xlWorksheet.Cells(1, 3).Value = "From Email Address"
    xlWorksheet.Cells(1, 4).Value = "Subject"
    xlWorksheet.Cells(1, 5).Value = "Email Folder Location"
    xlWorksheet.Cells(1, 6).Value = "Has Attachments"

    row = 2

    ' Loop through all subfolders
    For Each subfolder In folder.Folders
        For Each item In subfolder.Items
            If TypeName(item) = "MailItem" Then
                Set mailItem = item
                If mailItem.SenderEmailAddress = "example@outlook.com" Then
                    xlWorksheet.Cells(row, 1).Value = mailItem.ReceivedTime
                    xlWorksheet.Cells(row, 2).Value = mailItem.SenderName
                    xlWorksheet.Cells(row, 3).Value = mailItem.SenderEmailAddress
                    xlWorksheet.Cells(row, 4).Value = mailItem.Subject
                    xlWorksheet.Cells(row, 5).Value = subfolder.FolderPath
                    xlWorksheet.Cells(row, 6).Value = IIf(mailItem.Attachments.Count > 0, "True", "False")
                    row = row + 1
                End If
            End If
        Next item
    Next subfolder

    MsgBox "Export complete!", vbInformation

    ' Clean up
    Set xlWorksheet = Nothing
    Set xlWorkbook = Nothing
    xlApp.Quit
    Set xlApp = Nothing
    Set folder = Nothing
    Set outlookNamespace = Nothing
    Set outlookApp = Nothing
End Sub

You need to loop though the folder just like you would do it for folders and subfolders in windows explorer. Also I do not see a Date check?

Is this what you are trying? I have commented the code. If you still have a quesiton, then simply ask.

PS: I have divided the entire process in two procedures. This way it is easier to understand and manage the code.

Option Explicit

Sub ExportEmailsToExcel()
    Dim outlookApp As Outlook.Application
    Dim outlookNamespace As Outlook.NameSpace
    Dim rootFolder As Outlook.MAPIFolder
    Dim xlApp As Object
    Dim xlWorkbook As Object
    Dim xlWorksheet As Object
    Dim row As Long: row = 2 '<~~ Use Long and not Integer
    
    Set outlookApp = New Outlook.Application
    Set outlookNamespace = outlookApp.GetNamespace("MAPI")
    Set rootFolder = outlookNamespace.Folders("example@outlook.com")

    '~~> Create a new Excel workbook
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Set xlWorkbook = xlApp.Workbooks.Add
    Set xlWorksheet = xlWorkbook.Sheets(1)

    '~~> Set up the header row in Excel
    With xlWorksheet
        .Cells(1, 1).Value = "Date Received"
        .Cells(1, 2).Value = "From"
        .Cells(1, 3).Value = "From Email Address"
        .Cells(1, 4).Value = "Subject"
        .Cells(1, 5).Value = "Email Folder Location"
        .Cells(1, 6).Value = "Has Attachments"
    End With
    
    '~~> Loop through all folders and subfolders
    ProcessFolder rootFolder, xlWorksheet, row

    MsgBox "Export complete!", vbInformation
End Sub

'~~> Separate function for looping
Sub ProcessFolder(ByVal folder As Outlook.MAPIFolder, ByRef xlWorksheet As Object, ByRef row As Long)
    Dim subfolder As Outlook.MAPIFolder
    Dim item As Object
    Dim mailItem As Outlook.mailItem
    Dim dateLimit As Date
    
    '~~> Check for last 30 days
    dateLimit = DateAdd("d", -30, Now)
    
    '~~> Loop
    For Each item In folder.Items
        If TypeName(item) = "MailItem" Then
            Set mailItem = item
            If mailItem.ReceivedTime >= dateLimit Then
                xlWorksheet.Cells(row, 1).Value = mailItem.ReceivedTime
                xlWorksheet.Cells(row, 2).Value = mailItem.SenderName
                xlWorksheet.Cells(row, 3).Value = mailItem.SenderEmailAddress
                xlWorksheet.Cells(row, 4).Value = mailItem.Subject
                xlWorksheet.Cells(row, 5).Value = folder.FolderPath
                xlWorksheet.Cells(row, 6).Value = IIf(mailItem.Attachments.Count > 0, "True", "False")
                row = row + 1
            End If
        End If
    Next item
    
    '~~> Loop through sub folders if any
    For Each subfolder In folder.Folders
        ProcessFolder subfolder, xlWorksheet, row
    Next subfolder
End Sub