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, ByVal iLayersLeft As Integer)
    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
       If iLayersLeft > 1 Then
        FSO_GetAllFolders Liste, sPath & SubFolder.Name, _
           iLayersLeft - 1
        End If
    Next
  End If
End Sub

Web: http://www.vbtricks.de.vu/

VBTricks.de.vu. Meine Webseite zu VB und anderen Programmiersprachen. Verschiedene fortgeschrittene OCXe und komplette Projekte sind im Sourcecode verf?gbar.