Public Sub ListOutlookFolders()
        Dim olApp As Outlook.Application
        Dim olNamespace As Outlook.Namespace
        Dim olFolder As Outlook.MAPIFolder
 
        olApp = New Outlook.Application
        olNamespace = olApp.GetNamespace("MAPI")
        For Each olFolder In olNamespace.Folders
            Debug.WriteLine(olFolder.Name & ":" & olFolder.Description)
            ListFolders(olFolder, 1)
        Next
    End Sub
 
    Public Sub ListFolders(MyFolder As Outlook.MAPIFolder, Level As Integer)
        Dim olFolder As Outlook.MAPIFolder
        For Each olFolder In MyFolder.Folders
            Debug.WriteLine(":" & New String("-", Level * 2) & olFolder.Name & _
              "   " & olFolder.DefaultItemType.ToString())
            If olFolder.Folders.Count > 0 Then
                ListFolders(olFolder, Level + 1)
            End If
        Next
    End Sub

________
Alle Angaben ohne Gewähr. Keine Haftung für Vorschläge, Tipps oder sonstige Hilfe, falls es schiefgeht, nur Zeit verschwendet oder man sonst nicht zufrieden ist