Anzahl Dateien eines Ordners+Unterordner ermitteln Anzahl Dateien und Ordner eines Laufwerks/Verzeichnisses mit ggf. all seinen Unterordner ermitteln
Autor:   Jean Pierre Allain	Bewertung:     [ Jetzt bewerten ]	Views:  22.888
www.abiss.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

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

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

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:
Es soll die Anzahl Text-Dateien (.txt), sowie die Anzahl vorhandener Ordner auf dem Laufwerk C: ermitteln werden.

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