[VBA Excel] Liste les dossier d'un répertoire

Option Explicit  

Private oCollec As Collection  

Public Sub Macro1()  
Dim chemin As String  

    chemin = InputBox("Entrez le chemin du répertoire", "Répertoire")  
      
    Set oCollec = New Collection  
    SearchAllFilesInFolders (chemin)  
    AfficheListe  
    Set oCollec = Nothing  
      
End Sub  


Private Sub SearchAllFilesInFolders(ByVal chemin As String)  

Dim fso As FileSystemObject  
Dim dossier As Folder  

    Set fso = New FileSystemObject  
    Set dossier = fso.GetFolder(chemin)  
    Call scanFolder(dossier)  

End Sub  

Private Sub scanFolder(ByVal dossier As Folder)  
Dim sousdossier As Folder  
Dim fichier As File  

    For Each fichier In dossier.Files  
        oCollec.Add fichier  
    Next  

    For Each sousdossier In dossier.SubFolders  
        Call scanFolder(sousdossier)  
    Next  

End Sub  

Private Sub AfficheListe()  
Dim i As Long  
Dim lig As Long  
Dim ws As Worksheet  

    Set ws = ThisWorkbook.Worksheets(1)  
    lig = 2  
      
    With ws  
        For i = 1 To oCollec.Count  
            .Range("A" & lig).Value = oCollec(i)  
            lig = lig + 1  
        Next i  
    End With  
End Sub