<code><font color=green>' Baumstruktur ermitteln und anzeigen</font>
Private Sub Command1_Click()
  Screen.MousePointer = 11
  FillTreeView "F:\"  <font color=green>' Laufwerksbuchstabe des 
  ' CDROM-Laufwerks</font>
  Screen.MousePointer = 0
End Sub
 
 
<font color=green>' TreeView mit allen Ordnern eines Laufwerks füllen</font>
Public Sub FillTreeView(ByVal StartPath As String)
  Dim DirName As String
  Dim I As Integer
  Dim sPos As Integer
  Dim Ordner As String
  Dim MainOrdner As String
 
  <font color=green>' TreeView löschen</font>
  With TreeView1
    .Nodes.Clear
 
    <font color=green>' Verzeichnisse ermitteln</font>
    GetAllFolders StartPath
 
    <font color=green>' Erster Eintrag: Laufwerk selbst</font>
    .Nodes.Add , , StartPath, StartPath, 3, 3
 
    <font color=green>' Verzeichnisse</font>
    While List1.ListCount > 0
      DirName = List1.List(0)
      List1.RemoveItem 0
 
      sPos = InStrRev(DirName, "\")
      Ordner = Mid$(DirName, sPos + 1)
      MainOrdner = Left$(DirName, sPos - 1)
      If InStr(MainOrdner, "\") = 0 Then MainOrdner = MainOrdner + "\"
 
      .Nodes.Add MainOrdner, tvwChild, DirName, Ordner, 1, 2
    Wend
 
    <font color=green>' Root öffnen</font>
    .Nodes(1).Expanded = True
 
  End With
End Sub
 
 
<font color=green>' Rekursive Prozedur zum Ermitteln aller Verzeichnisse</font>
Private Sub GetAllFolders(ByVal Pfad As String)
  Dim Count As Long
  Dim I As Long
  Dim DirName() As String
 
  On Local Error Resume Next
  Count = GetAllSubDir(Pfad, DirName())
  I = 1
  Do Until I > Count
    List1.AddItem Pfad + DirName(I)
    GetAllFolders Pfad + DirName(I) + "\"
    I = I + 1
  Loop
  On Local Error GoTo 0
End Sub
 
<font color=green>' Unterverzeichnisse eines Ordners ermitteln</font>
Private Function GetAllSubDir(Path As String, _
  D() As String) As Integer
 
  Dim DirName As String
  Dim Count As Integer
 
  If Right$(Path, 1) <> "\" Then Path = Path + "\"
  DirName = Dir(Path, vbDirectory)
  Count = 0
  Do While DirName <> ""
    If DirName <> "." And DirName <> ".." Then
      If (GetAttr(Path + DirName) And vbDirectory) = vbDirectory Then
        If (Count Mod 10) = 0 Then
          ReDim Preserve D(Count + 10) As String
        End If
        Count = Count + 1
        D(Count) = DirName
      End If
    End If
    DirName = Dir
  Loop
  GetAllSubDir = Count
End Function</code>