Hallo Sascha,

versuch es mal mit 2 Schleifen, eine durch die Inbox und dann durch alle Unterordner der Inbox.

Private Sub CommandButton1_Click()
 
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim olItem As MailItem
    Dim olInbox  As Outlook.MAPIFolder
    Dim olFolder As Outlook.MAPIFolder
    Dim ws As Worksheet
     
    Set ws = ThisWorkbook.Worksheets("Arbeitsmappe 1")
 
    Set olApp = New Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    Set olInbox = olNS.GetDefaultFolder(olFolderInbox)
     
        ws.Cells.Range("A2:D300").ClearContents
    iRow = 2
     
    Application.ScreenUpdating = False
    For Each olItem In olInbox.Items
        If olItem.Class = olMail Then
            With olItem
                ws.Cells(iRow, "A") = .Sender
                ws.Cells(iRow, "B") = .Subject
                ws.Cells(iRow, "C") = .ReceivedTime
                ws.Cells(iRow, "D") = "Inbox"
                iRow = iRow + 1
            End With
        End If
    Next olItem
    
    For Each olFolder In olInbox.Folders
        For Each olItem In olFolder.Items
            If olItem.Class = olMail Then
                With olItem
                    ws.Cells(iRow, "A") = .Sender
                    ws.Cells(iRow, "B") = .Subject
                    ws.Cells(iRow, "C") = .ReceivedTime
                    ws.Cells(iRow, "D") = olFolder.Name
                    iRow = iRow + 1
                End With
            End If
        Next
    Next
 
    With ws
        hdr = Array("Sender", "Subject", "  Received Time  ", "    Folder    ", "Platzhalter")
        .Range("A1").Resize(, UBound(hdr)) = hdr
        .Columns.AutoFit
    End With
    Application.ScreenUpdating = False
    End Sub

Gruss Torsten