Option Explicit
Dim FSO As FileSystemObject
 
Private Sub cmdGO_Click()
  Dim sPath As String
 
  ' Alle Unterverzeichnisse lesen und in einer
  ' ListBox anzeigen
  List1.Clear
 
  ' FileSystemObject initialisieren
  Set FSO = New FileSystemObject
 
  ' Start-Ordner
  Screen.MousePointer = vbHourglass
  sPath = Left$(Drive1.Drive, 2)
  FSO_GetAllFolders List1, sPath
  Screen.MousePointer = vbNormal
End Sub
 
' Rekursive Funktion zum Ermitteln aller
' Ordner und Unterordner
 
Private Sub FSO_GetAllFolders(Liste As ListBox, _
  ByVal sPath As String)
 
  Dim Folder As Folder
  Dim SubFolder As Folder
 
  ' Ggf. abschliessenden Backslash anfügen
  If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
 
  Set Folder = FSO.GetFolder(sPath)
  Liste.AddItem sPath
 
  ' Ggf. Fehler "Zugriff verweigert" ignorieren
  On Local Error Resume Next
 
  ' Unterordner lesen
 
  If Folder.SubFolders.Count > 0 Then
    For Each SubFolder In Folder.SubFolders
      ' Hier wird die Funktion REKURSIV aufgerufen,
      ' um alle weiteren Unterordner des SubFolders
      ' zu ermitteln
      FSO_GetAllFolders Liste, sPath & SubFolder.Name
    Next
  End If
End Sub

Vielen Dank, Christian