VBA: Obtenir le nom des dossiers présents dans un repertoire

Sub liste_sous_dossier()
  Dim fso As FileSystemObject
  Dim d As Folder
  Dim sd As Folder
  Dim chemin As String
  
  chemin = "c:\wamp"
  
  Set fso = New FileSystemObject
  Set d = fso.GetFolder(chemin)
  
  For Each sd In d.SubFolders
    Debug.Print sd.Name
  Next
End Sub

Dim ligne
Sub arborescenceRepertoire()
  racine = ChoixDossier()     ' ou un répertoire C:\xxx e.g.
  If racine = "" Then Exit Sub
  Range("A:E").ClearContents
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier_racine = fs.getfolder(racine)
  ligne = 3
  Lit_dossier dossier_racine, 1
End Sub

Sub Lit_dossier(ByRef dossier, ByVal niveau)
   Cells(ligne, 1) = String(3 * (niveau - 1), " ") & dossier.Name
   ligne = ligne + 1
   For Each d In dossier.SubFolders
     Lit_dossier d, niveau + 1
   Next
End Sub

Function ChoixDossier()
    If Val(Application.Version) >= 10 Then
       With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ActiveWorkbook.Path & "\"
        .Show
        If .SelectedItems.Count > 0 Then
           ChoixDossier = .SelectedItems(1)
        Else
           ChoixDossier = ""
        End If
       End With
     Else
       ChoixDossier = InputBox("Répertoire?")
     End If
End Function

Sub Lit_dossier(ByRef dossier, ByVal niveau)
   Cells(ligne, 1) = String(3 * (niveau - 1), " ") & dossier.Name
   ligne = ligne + 1
   For Each d In dossier.SubFolders
     If niveau < 2 Then Lit_dossier d, niveau + 1
   Next
End Sub

Dim ligne
Sub arborescenceRepertoire()
  racine = "C:\Users\subias.CGPA\Documents\agent"    ' ou un répertoire C:\xxx e.g.
  If racine = "" Then Exit Sub
  Range("A:E").ClearContents
  Set fs = CreateObject("Scripting.FileSystemObject")
  Set dossier_racine = fs.getfolder(racine)
  ligne = 3
  Lit_dossier dossier_racine, 1
End Sub
Sub Lit_dossier(ByRef dossier, ByVal niveau)
   Cells(ligne, 1) = String(3 * (niveau - 1), " ") & dossier.Name
   'ligne = ligne + 1
   For Each d In dossier.SubFolders
     Lit_dossier d, niveau + 1
   Next
End Sub

 Sub arborescenceRepertoire()
   racine = "C:\wamp"    ' ou un répertoire C:\xxx e.g.
   If racine = "" Then Exit Sub
   Range("A:E").ClearContents
   Set fs = CreateObject("Scripting.FileSystemObject")
   Set dossier = fs.GetFolder(racine)
   ligne = 3
    For Each d In dossier.SubFolders
      Cells(ligne, 1) = d.Name
      ligne = ligne + 1
    Next
 End Sub