Sub TousLesDossiers(LeDossier$, IDX As Long)
'Frederic Sigonneau
IDX = Range("A65536").End(xlUp).Rows.Row
    Dim fso As Object, Dossier As Object
    Dim sousRep As Object, Flder As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set Dossier = fso.GetFolder(LeDossier)
 
    'Set Dossier = USF_Options_Excel!TB_DD
    'MsgBox Dossier
    'MsgBox LeDossier
    'IDX = IDX + 1
    'examen du dossier courant
    'Cells(IDX, 1).Value = LeDossier
    'Stop
    For Each Flder In Dossier.subfolders
        IDX = IDX + 1
        Cells(IDX, 1).Value = Flder.Path
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(IDX, 2), Address:= _
        Flder.Path
    Next
    'Stop
    'traitement récursif des sous dossiers
    For Each sousRep In Dossier.subfolders
        TousLesDossiers sousRep.Path, IDX
    Next sousRep
    Set fso = Nothing
End Sub

How to list recursively files, in an excel sheet ?

[vba-excel] lister fichiers dossiers, et sous-dossiers

list, files, directory

Visual Basic