Lister les dossiers

Lister les dossiers et sous-dossiers (sur 4 niveaux...)

Public Sub ListFolders()
    Dim Ol_App As New Outlook.Application
    Dim Ol_MAPI As Outlook.NameSpace
    Dim Ol_Folder1 As Outlook.MAPIFolder
    Dim Ol_Folder2 As Outlook.MAPIFolder
    Dim Ol_Folder3 As Outlook.MAPIFolder
    Dim Ol_Folder4 As Outlook.MAPIFolder

    Set Ol_MAPI = Ol_App.GetNamespace("MAPI")

    For Each Ol_Folder1 In Ol_MAPI.Folders
        Debug.Print Ol_Folder1.Name
        Set Ol_Folder2 = Ol_MAPI.Folders(Ol_Folder1.Name)
        For Each Ol_Folder2 In Ol_Folder2.Folders
            Debug.Print " |__" & Ol_Folder2.Name
            Set Ol_Folder3 = Ol_MAPI.Folders(Ol_Folder1.Name). _
                             Folders(Ol_Folder2.Name)
            For Each Ol_Folder3 In Ol_Folder3.Folders
                Debug.Print " |" & Space$; ­(4) & "|__" & Ol_Folder3.Name
                Set Ol_Folder4 = Ol_MAPI.Folders(Ol_Folder1.Name). _
                                 Folders(Ol_Folder2.Name). _
                                 Folders(Ol_Folder3.Name)
                For Each Ol_Folder4 In Ol_Folder4.Folders
                    Debug.Print " |" & Space$; ­(16) & "|__" & Ol_Folder4.Name
                Next Ol_Folder4
            Next Ol_Folder3
        Next Ol_Folder2
    Next Ol_Folder1
    
    Set Ol_Folder4 = Nothing
    Set Ol_Folder3 = Nothing
    Set Ol_Folder2 = Nothing
    Set Ol_Folder1 = Nothing
    Set Ol_MAPI = Nothing
    Set Ol_App = Nothing

End Sub