Ordner im TreeView à la Explorer 2 Alle Ordner eines Verzeichnisses im TreeView darstellen. Um die Perfomance zu steigern, werden jedoch nur die Ordner geladen, die man auch tatsächlich sehen kann!
Autor:   Hermann Klinke	Bewertung:     [ Jetzt bewerten ]	Views:  29.962
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 49 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.1 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Vor kurzem haben wir Ihnen einen Code vorgestellt, mit dem sich schnell alle Ordner eines Laufwerks in einem TreeView-Control anzeigen lassen. Dieser Tipp wurde nun nochmals überarbeitet und ist jetzt nocht effizienter und schneller.

Ab sofort werden "Dummys" eingesetzt, die nur dafür da sind, damit das '+'-Zeichen erscheint. Dadurch wird das öffnen des Ordner beschleunigt, da man diesmal wirklich nur das laden muss, was man auch sehen kann. Zusätzlich gibt es im Beispiel eine Fehlerroutine, die einen Ordner aus dem TreeView löscht, der angezeigt wird, aber nicht mehr vorhanden ist. Durch diese Verbesserungen ähnelt die Methode noch stärker dem Microsoft Explorer!

Hier die einzelnen Funktionen mit kurzen Beschreibungen:

• als sDirectory übergibt man das Verzeichnis, das geladen werden soll
• als sImage übergibt man den Key des Bildes (am besten ein Ordner) einer ImageList
• sExpandedImage verhält sich wie oben und legt den Key für das Bild eines geöffneten Ordners fest

Fügen Sie nachfolgenden Code in ein Modul ein:

' Diese Funktion lädt die erste Ebene eines
' Verzeichnisses und gibt die Nodes als Collectionen
' zurück
Function LoadWithFolders(oTreeView As TreeView, _
  sDirectory As String, _
  sImage As String, _
  sExpandedImage As String) As Collection
 
  Dim vFolder         As Variant
  Dim oNode           As Node
  Dim coNodes         As New Collection
  Dim coFolders       As New Collection
 
  ' Unterordner holen
  Set coFolders = GetSubFolders(sDirectory)
  For Each vFolder In coFolders
    ' jeden Ordner mit Bild dem TreeView hinzufügen
    Set oNode = oTreeView.Nodes.Add(, tvwLast, , vFolder, sImage)
 
 
    ' Icon setzen, wenn es aufgeklappt wird
    oNode.ExpandedImage = sExpandedImage
    Call coNodes.Add(oNode)
  Next vFolder
  Set LoadWithFolders = coNodes
End Function

' Diese Funktion fügt ein namenloses Dummynode-Objekt
' hinzu, das nur den Zweck hat, das '+'-Zeichen anzuzeigen.
' Die Funktion gibt zurück, ob ein Dummy erstellt worden ist
Function AddChildDummy(oTreeView As TreeView, _
  oParentNode As Node, _
  sDirectory As String) As Boolean
 
  Dim oDummyNode As Node
 
  ' wenn nicht schon geladen wurde und 
  ' Unterordner vorhanden sind
  If (oParentNode.Children = 0) And (AreSubFolder(sDirectory)) Then
    ' wenn Dummynode nicht vorhanden ist
    On Error Resume Next 
    With oTreeView
      Set oDummyNode = .Nodes.Item(oParentNode.FullPath & "\Dummy")
      If Err = 35601 Then ' soll sie hinzugefügt werden
        .Nodes.Add oParentNode, tvwChild, oParentNode.FullPath & "\Dummy"
        AddChildDummy = True
      End If
      On Error GoTo 0
    End With
  End If
End Function

' Diese Funktion überprüft, ob es Unterornder
' in dem angegebenen Verzeichnis gibt
Function AreSubFolder(sDir As String) As Boolean
  Dim sItem As String
 
  ' ersten Ordner
  sItem = Dir$(sDir & "\*", vbDirectory)
  Do
    If Left$(sItem, 1) <> "." Then
      If ExistDir(sDir & "\" & sItem) Then
        AreSubFolder = True
        Exit Do
      End If
    End If
    sItem = Dir$
  Loop Until sItem = vbNullString
End Function

' Diese Funktion entfernt das Dummynode-Objekt 
' und gibt als Ergebnis zurück, ob sie gelöscht wurde
Function RemoveChildDummy(oTreeView As TreeView, _
  oParentNode As Node) As Boolean
 
  Dim oDummyNode As Node
 
  ' wenn das Objekt existiert wird es gelöscht
  On Error Resume Next
  With oTreeView.Nodes
    Set oDummyNode = .Item(oParentNode.FullPath & "\Dummy")
    If Err = 0 Then
      .Remove oParentNode.FullPath & "\Dummy"
      RemoveChildDummy = True
    End If
    On Error GoTo 0
  End With
End Function

' Diese Funktion fügt alle Unterordner (inklusive 
' Dummynode-Objekte)eines Verzeichnisses hinzu und 
' gibt sie als Collection zurück
Function AddSubFolders(oTreeView As TreeView, _
  oParentNode As Node, _
  sDirectory As String, _
  sImage As String, _
  sExpandedImage As String) As Collection
 
  Dim vSubFolder      As Variant
  Dim oNode           As Node
  Dim coSubFolders    As Collection
  Dim coChildNodes    As New Collection
 
  ' wenn Unterordner vorhanden sind
  If (AreSubFolder(sDirectory)) Then
    ' Dummynode entfernen
    RemoveChildDummy oTreeView, oParentNode
 
    ' Unterordner holen
    Set coSubFolders = GetSubFolders(sDirectory)
 
    ' Alle Unterordner inkl. Dummynodes hinzufügen
    For Each vSubFolder In coSubFolders
      With oTreeView
        Set oNode = .Nodes.Add(oParentNode, tvwChild, , vSubFolder, sImage)
        oNode.ExpandedImage = sExpandedImage
        AddChildDummy oTreeView, oNode, sDirectory & "\" & oNode.Text
 
        ' Childnode der Collection hinzufügen
        coChildNodes.Add oNode
      End With
    Next vSubFolder
 
    ' Collection zurückgeben
    Set AddSubFolders = coChildNodes
  End If
End Function

' Diese Funktion löscht alle Childnodes 
' eines Node-Objekts
Sub DeleteChildNodes(oTreeView As TreeView, _
  oNode As Node, _
  sDirectory As String)
 
  Dim x               As Long
  Dim oChildNode      As Node
  Dim oNextNode       As Node
 
  ' 1. Childnode
  Set oChildNode = oNode.Child
  For x = 1 To oNode.Children
    ' Nächstes Childnode "merken"
    Set oNextNode = oChildNode.Next
 
    ' Childnode löschen
    oTreeView.Nodes.Remove oChildNode.Index
 
    ' Gehe zu nächstem Childnode
    Set oChildNode = oNextNode
  Next x
 
  ' Dummynode hinzufügen
  Call AddChildDummy(oTreeView, oNode, sDirectory)
End Sub

' Diese Funktion ermittelt die Unterordner 
' eines Verzeichnisses und gibt deren Namen in 
' einer Collection zurück
Function GetSubFolders(sDirectory As String) As Collection
 
  Dim sFolder         As String
  Dim coSubFolders    As New Collection
 
  If ExistDir(sDirectory) Then
    sFolder = Dir(sDirectory & "\*", vbDirectory)
    Do While sFolder <> vbNullString
      ' aus den alten DOS Zeiten, gibt es noch die
      ' Ordner, die einfach nur "." und ".." heißen.
      ' Diese werden hier aussortiert.
      If Left$(sFolder, 1) <> "." And _
        ExistDir(sDirectory & "\" & sFolder) Then
 
        coSubFolders.Add sFolder
      End If
 
      ' nächsten Ordner
      sFolder = Dir
    Loop
    Set GetSubFolders = coSubFolders
  End If
End Function

' Diese Funktion überprüft, ob es sich bei dem
' übergebenen Verzeichnis um einen existierenden
' Ordner handelt
Function ExistDir(sDir As String) As Boolean
  ' Falls Verzeichnis nicht vorhanden ist
  On Error Resume Next
  ExistDir = ((GetAttr(sDir) And vbDirectory)) And (Err = 0)
  On Error GoTo 0
End Function

Beispiel:
Ziehen Sie auf das Formular ein TreeView- und ein ImageList-Control. Fügen Sie der ImageList ein Bild mit einem geschlossenem Ordner hinzu und legen als Key "OrdnerZu" fest. Fügen Sie der ImageList ein weiteres Bild mit einem offenem Ordner hinzu und legen als Key "OrdnerOffen" fest.

Option Explicit
Private sDirectory As String

Private Sub Form_Load()
  ' ImageList zuordnen
  Set TreeView1.ImageList = ImageList1
 
  ' Startordner
  sDirectory = "c:"
 
  ' Alle Ordner in C: anzeigen
  LoadWithFolders TreeView1, sDirectory, _
    "OrdnerZu", "OrdnerOffen"
End Sub

Private Sub TreeView1_Collapse(ByVal Node As MSComctlLib.Node)
  ' Beim Schließen alle Unterordner löschen
  DeleteChildNodes TreeView1, Node, _
    sDirectory & "\" & Node.FullPath
End Sub

Private Sub TreeView1_Expand(ByVal Node As MSComctlLib.Node)
  ' wenn Unterordner vorhanden sind:
  ' + Dummy löschen
  ' + Alle Unterordner hinzufügen
  AddSubFolders TreeView1, Node, _
    sDirectory & "\" & Node.FullPath, _
    "OrdnerZu", "OrdnerOffen"
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
  ' wenn Verzeichnis noch vorhanden ist
  If ExistDir(sDirectory & "\" & Node.FullPath) Then
    ' wenn Unterordner vorhanden sind:
    ' einen Dummy erstellen, damit das '+'-Zeichen sichbar ist
    AddChildDummy TreeView1, Node, sDirectory & "\" & Node.FullPath
  Else 
    ' wenn nicht, dann wird es aus TreeView gelöscht
    TreeView1.Nodes.Remove Node.Index
  End If
End Sub