Nachfolgende Funktion ermittelt die Anzahl vorhandener Dateien in einem Ordner und ggf. in all seinen Unterordnern und gibt diese als Long-Wert zurück. ' Anzahl Dateien eines Ordners und ggf. aller Unterordner ermitteln Public Function NumberOfFiles(ByVal Path As String, _ Optional ByVal FileFilter As String = "*.*", _ Optional nbFiles As Long, _ Optional Subfolders As Boolean, _ Optional FolderFilter As String = "*.*", _ Optional nbFolders As Long) As Long Dim List() As String Dim i As Long If Not Right$(Path, 1) = "\" Then Path = Path & "\" If CreateItemlist(Path, FileFilter, List, False, _ vbHidden + vbSystem) Then nbFiles = nbFiles + UBound(List) + 1 If CreateItemlist(Path, FolderFilter, List, True, _ vbHidden + vbSystem) Then nbFolders = nbFolders + UBound(List) + 1 If Subfolders Then For i = 0 To UBound(List) NumberOfFiles Path & List(i), FileFilter, nbFiles, _ Subfolders, FolderFilter, nbFolders Next i End If End If NumberOfFiles = nbFiles End Function Private Function CreateItemlist(ByVal Path As String, _ ByVal Filter As String, ByRef List() As String, _ ByVal OnlyFolders As Boolean, _ Optional ByVal Typ As Long = vbNormal) As Boolean Dim tmp As String Dim i As Long Dim Append As Boolean On Error Resume Next ReDim List(0) If OnlyFolders Then Typ = Typ Or vbDirectory tmp = Dir$(Path & Filter, Typ) Do Until Len(tmp) = 0 If Not (tmp = "." Or tmp = "..") Then Append = False If OnlyFolders Then If (GetAttr(Path & tmp) And vbDirectory) = vbDirectory Then Select Case Err.Number Case 0 Append = True Case 75 Err.Clear Case Else Exit Function End Select End If Else Append = True End If If Append Then ReDim Preserve List(i) List(i) = tmp i = i + 1 End If End If tmp = Dir$ Loop CreateItemlist = (Not i = 0) End Function Beispielaufruf: Dim nFiles As Long Dim nFolders As Long ' Unterordner einbeziehen NumberOfFiles "C:\", "*.txt", nFiles, True, , nFolders MsgBox "Anzahl Dateien: " & nFiles & vbCrLf & vbCrLf & _ "Anzahl Ordner: " & nFolders Dieser Tipp wurde bereits 21.886 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. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 sevWizard für VB5/6 Professionelle Assistenten im Handumdrehen Erstellen Sie eigene Assistenten (Wizards) im Look & Feel von Windows 2000/XP - mit allem Komfort und zwar in Windeseile :-) |
||||||||||||||||
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. |