Sub TousLesDossiers(LeDossier$, Idx As Long)
    Dim strDossier As String
    Dim strFichier As String
    Dim FSO As Object, Dossier As Object
    Dim sousRep As Object, Flder As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Dossier = FSO.GetFolder(LeDossier)
    
    'examen du dossier courant
    For Each Flder In Dossier.SubFolders
        Idx = Idx + 1
        Cells(Idx, 1).Value = Flder.Path & "\"
        'Rajou de fichier #début
          ' Lister tous les fichiers du dossier
        strFichier = Dir(Flder.Path & "\", vbNormal)
        While strFichier <> ""
            ' Afficher le nom du fichier
            Idx = Idx + 1
            Cells(Idx, 1).Value = Flder.Path & "\" & strFichier
            'Lire le fichier suivant
            strFichier = Dir
        Wend
        'rajout de fichier #fin
    Next
    'traitement récursif des sous dossiers
    For Each sousRep In Dossier.SubFolders
        TousLesDossiers sousRep.Path, Idx
    Next sousRep
    Set FSO = Nothing
End Sub

list directories subdirectories

How to list directories and subdirectories in an excel sheet ?

[vba-excel] lister dossiers et sous-dossiers d'un répertoire

list, files

Visual Basic