Sie kenn sicherlich das Dir-Steuerelement in VB zum Darstellen und Auswählen eines Ordners. Leider sieht das optisch nicht so ansprechend aus, wie z.B. die Ordnerauswahl im Explorer. Also, liegt es nahe, die Ordnerauswahl des Explorers nachzubauen. Alles, was Sie hierfür benötigen, sind eine unsichtbare Listbox, mit der Eigenschaft Sorted = True, ein TreeView-Steuerelement und eine Abbildungsliste (ImageList). Fügen Sie der Abbildungsliste drei Bildsymbole hinzu (Format 16x16), und zwar:
Die Listbox wird benötigt, um alle über die Dir-Funktion ermittelten Ordner und Unterordner automatisch sortieren zu lassen. Das TreeView-Control wird dann mit den ListBox-Einträgen gefüllt. Und hier der Code: ' TreeView mit allen Ordnern eines Laufwerks füllen 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 ' TreeView löschen With TreeView1 .Nodes.Clear ' Verzeichnisse ermitteln If Right$(StartPath, 1) = ":" Then _ StartPath = StartPath + "\" GetAllFolders StartPath ' Erster Eintrag: Laufwerk selbst .Nodes.Add , , StartPath, StartPath, 3, 3 ' Verzeichnisse 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 ' Root öffnen .Nodes(1).Expanded = True End With End Sub ' Rekursive Prozedur zum Ermitteln aller Verzeichnisse 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 ' Unterverzeichnisse eines Ordners ermitteln 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 Aufgerufen wird die Funktion dann so: Private Sub Command1_Click() Screen.MousePointer = 11 ' aktuelles Laufwerk FillTreeView Left$(CurDir$, 2) Screen.MousePointer = 0 End Sub Anmerkungen Aber das möchten wir mal Ihnen selber überlassen - vielleicht jedoch, finden Sie hier demnächst schon eine wesentlich verbesserte Routine (vor allen Dingen in Bezug auf die Geschwindigkeit!) oder Sie schicken uns Ihre verbesserte Routine zu... 16.10.07: Update von Timo Schreiber ' TreeView mit allen Ordnern eines Laufwerks füllen Public Sub FillTreeView(ByVal StartPath As String) If Right$(StartPath, 1) = ":" Then StartPath = StartPath & "\" With TreeView1 ' TreeView löschen .Nodes.Clear ' Erster Eintrag: Laufwerk selbst .Nodes.Add , , StartPath, StartPath, 4, 4 ' Verzeichnisse ermitteln GetAllFolders StartPath ' Root öffnen .Nodes(1).Expanded = True End With End Sub ' Rekursive Prozedur zum Ermitteln aller Verzeichnisse Private Sub GetAllFolders(ByVal Pfad As String) Dim Count As Long Dim I As Long Dim DirName() As String Dim sPos As Integer Dim Ordner As String Dim MainOrdner As String Dim MainPath As String On Error Resume Next Count = GetAllSubDir(Pfad, DirName()) I = 1 Do Until I > Count MainPath = Pfad & DirName(I) ' Verzeichnisse sPos = InStrRev(MainPath, "\") Ordner = Mid$(MainPath, sPos + 1) MainOrdner = Left$(MainPath, sPos - 1) If InStr(MainOrdner, "\") = 0 Then MainOrdner = MainOrdner + "\" If (GetAttr(MainPath) And vbDirectory) = vbDirectory Then TreeView1.Nodes.Add MainOrdner, tvwChild, MainPath, Ordner, 1, 3 Else TreeView1.Nodes.Add MainOrdner, tvwChild, MainPath, Ordner, 2, 2 End If GetAllFolders Pfad & DirName(I) & "\" I = I + 1 Loop On Error GoTo 0 End Sub ' Unterverzeichnisse eines Ordners ermitteln 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 (Count Mod 10) = 0 Then ReDim Preserve D(Count + 10) As String End If Count = Count + 1 D(Count) = DirName End If DirName = Dir Loop GetAllSubDir = Count End Function Dieser Tipp wurde bereits 39.844 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
sevZIP40 Pro DLL Zippen und Unzippen wie die Profis! Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. Access-Tools Vol.1 Über 400 MByte Inhalt Mehr als 250 Access-Beispiele, 25 Add-Ins und ActiveX-Komponenten, 16 VB-Projekt inkl. Source, mehr als 320 Tipps & Tricks für Access und VB |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |