Der nachfolgende Tipp zeigt, wie man nach bestimmten Dateien innerhalb eines bestimmten Ordners und den darin enthaltenen Unterordnern suchen kann. Das ganze erfolgt über die Windows-API Befehle FindFirstFile und FindNextFile. Die Suchroutine unterstützt desweiteren auch Wildcards (* oder ?). Die Ergebnisliste wird in einem ARRAY-Datenfeld gespeichert, welche dann leicht in einer Liste dargestellt werden kann. ' zunächst die benötigten API-Deklarationen Private Declare Function FindFirstFile Lib "kernel32" _ Alias "FindFirstFileA" ( _ ByVal lpFileName As String, _ lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindNextFile Lib "kernel32" _ Alias "FindNextFileA" ( _ ByVal hFindFile As Long, _ lpFindFileData As WIN32_FIND_DATA) As Long Private Declare Function FindClose Lib "kernel32" ( _ ByVal hFindFile As Long) As Long Private Declare Function GetShortPathName Lib "kernel32" _ Alias "GetShortPathNameA" ( _ ByVal lpszLongPath As String, _ ByVal lpszShortPath As String, _ ByVal cchBuffer As Long) As Long Private Const MAX_PATH = 260 Private Const INVALID_HANDLE_VALUE = -1 Public Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Private Type WIN32_FIND_DATA dwFileAttributes As Long ' Dateiattribute ftCreationTime As FILETIME ' Erstellungsdatum ftLastAccessTime As FILETIME ' Letzter Zugriff ftLastWriteTime As FILETIME ' Letzte Speicherung nFileSizeHigh As Long ' Größe (Hi) nFileSizeLow As Long ' Größe (Lo) dwReserved0 As Long ' bedeutungslos dwReserved1 As Long ' bedeutungslos cFileName As String * MAX_PATH ' Dateiname cAlternate As String * 14 ' 8.3-Dateiname End Type Public Type Datei Pfadname As String DosDateiname As String Dateiname As String ErstelltAM As FILETIME LetzterZugriff As FILETIME LetzeÄnderung As FILETIME DateiGröße As Long Atribute As Long End Type Public WasFound() As Datei Public StopSearch As Boolean ' Suchroutine: Wildcards sind erlaubt (*.*, ?, ect.) Public Function FindFile(ByVal StartPath As String, _ ByVal SearchSubfolder As Boolean, _ ByVal File As String, _ ByRef FileFound() As Datei) Dim hFile As Long Dim FileData As WIN32_FIND_DATA Dim Directories() As String Dim OnlyDirectories As Boolean Dim TmpFile As String Dim I As Integer DoEvents ' Evtl. Backslash entfernen If Right$(StartPath, 1) = "\" Then _ StartPath = Left$(StartPath, Len(StartPath) - 1) SearchOnlySubfolders: ' Sucht nach einer Datei, und packt das ' Ergebnis in FileData hFile = FindFirstFile(StartPath & "\" & File & _ vbNullChar, FileData) ' Wenn sie gefunden wurde, dann... If hFile <> INVALID_HANDLE_VALUE Then Do ' Ist es ein Verzeichniss oder eine Datei ? With FileData If (.dwFileAttributes And vbDirectory) = 0 Then ' Datei ' Nur wenn nicht nur Verzeichinsse gesucht werden If Not OnlyDirectories Then ' Array vergrößern und Daten ins Array schreiben On Error GoTo Err_DimFile ReDim Preserve FileFound(UBound(FileFound) + 1) On Error GoTo 0 DoEvents UmPacken FileFound(UBound(FileFound)), _ FileData, StartPath & "\" & File End If If StopSearch = True Then Exit Function ElseIf SearchSubfolder = True Then ' Verzeichnis ' Verzeichnis nur im Array Speichern wenn es ' über dem jetzigen liegt d.h. ".." "." sind ' nicht gültig If Left$(.cFileName, InStr(.cFileName, vbNullChar) - 1) <> "." _ And Left$(.cFileName, InStr(.cFileName, vbNullChar) - 1) <> ".." Then On Error GoTo Err_DimDir ReDim Preserve Directories(UBound(Directories) + 1) On Error GoTo 0 ' Verzeichnis dem Array hinzufügen Directories(UBound(Directories)) = _ Left$(.cFileName, InStr(.cFileName, vbNullChar) - 1) End If End If End With DoEvents Loop Until FindNextFile(hFile, FileData) = 0 Or StopSearch = True End If FindClose hFile ' Unteroder durchsuchen On Error GoTo Err_DimDir If SearchSubfolder = False Or _ StopSearch = True Then Exit Function On Error GoTo 0 ' Wenn nach anderen Dateien als *.* gesucht wird, ' werden keine Ordner gefunden ' Deshalb noch einmal gezielt nach Ordnern suchen If Not OnlyDirectories And SearchSubfolder = True And _ File <> "*.*" Then OnlyDirectories = True TmpFile = File File = "*.*" GoTo SearchOnlySubfolders ElseIf TmpFile <> "" Then File = TmpFile End If On Error GoTo Err_Exit For I = 0 To UBound(Directories) If StopSearch = True Then Exit Function DoEvents ' Hier ruft die Funktion sich selbst auf - für ' jeden Unterordner FindFile StartPath & "\" & Directories(I), _ SearchSubfolder, File, FileFound Next I Exit Function Err_DimFile: ReDim FileFound(0) Resume Next Err_DimDir: ReDim Directories(0) Resume Next Err_Exit: End Function ' Packt die Infos um und schneidet Nullchar-Zeichen ab Private Function UmPacken(ByRef D As Datei, _ FD As WIN32_FIND_DATA, ByVal Path As String) With FD D.Atribute = .dwFileAttributes D.DateiGröße = .nFileSizeLow D.Dateiname = Left$(.cFileName, InStr(.cFileName, _ vbNullChar) - 1) D.DosDateiname = Left$(.cAlternate, _ InStr(.cAlternate, vbNullChar) - 1) If D.DosDateiname = "" Then _ D.DosDateiname = D.Dateiname D.ErstelltAM = .ftCreationTime D.LetzeÄnderung = .ftLastWriteTime D.LetzterZugriff = .ftLastAccessTime D.Pfadname = Left$(Path, InStrRev(Path, "\")) End With End Function Beispiel: Public Sub StartS() Dim Dateien() As Datei StopSearch = False FindFile "C:\Windows\Media", True, "*.*", Dateien ' Ergebnisliste in Form1.List1 ausgeben Form1.List1.Clear For i = 0 To UBound(Dateien) Form1.List1.AddItem Dateien(i).Dateiname Next i End Sub ' Und stoppen kann man das ganze hier Public Sub StopS() StopSearch = True End Sub Dieser Tipp wurde bereits 54.897 mal aufgerufen.
Anzeige
![]() ![]() ![]() (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. |
TOP! Unser Nr. 1 ![]() Neu! sevDataGrid 3.0 Mehrspaltige Listen, mit oder ohne DB-Anbindung. Autom. Sortierung, Editieren von Spalteninhalten oder das interaktive Hinzufügen von Datenzeilen sind ebenso möglich wie das Erstellen eines Web-Reports. Tipp des Monats ![]() Dieter Otter sevTabStrip: Rechtsklick auf Reiter erkennen Eine Funktion, mit der sich prüfen lässt, auf welchen Tab-Reiter ein Mausklick erfolgte TOP Entwickler-Paket ![]() TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1866.50 EUR... |
||||||||||||||||
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. |