'Kompletten Dateibaum durchsuchen

'http://www.vb-tec.de/fndfiles.htm

Public Declare PtrSafe Sub FindClose Lib "kernel32" ( _
    ByVal hFindFile As Long)
Public Declare PtrSafe Function FindFirstFileA Lib "kernel32" ( _
    ByVal lpFileName As String, _
    lpFindFileData As WIN32_FIND_DATA _
  ) As Long
Public Declare PtrSafe Function FindNextFileA Lib "kernel32" ( _
    ByVal hFindFile As Long, _
    lpFindFileData As WIN32_FIND_DATA _
  ) As Long
Public Declare PtrSafe Function GetFileAttributesA Lib "kernel32" ( _
    ByVal lpFileName As String _
  ) As Long

Public Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * 260
  cAlternate As String * 14
End Type

-------------------------------------------------------------
Dim DateienPDF              As Collection       'Collection für den PDF-Fundus

            FindFiles PdfPath, DateienPDF, "*.pdf", vbArchive
            If DateienPDF.Count Then
                Call MsgBox(DateienPDF.Count & " PDF-Dateien gefunden!", vbSystemModal, "Information")
            Else
                Call MsgBox("Keine PDF-Dateien gefunden!", vbSystemModal, "Information")
            End If
-------------------------------------------------------------



'http://www.vb-tec.de/fndfiles.htm
Public Function FindFiles( _
    ByVal Path As String, _
    ByRef Files As Collection, _
    Optional ByVal Pattern As String = "*.*", _
    Optional ByVal Attributes As VbFileAttribute = vbNormal, _
    Optional ByVal Recursive As Boolean = True _
  ) As Long
  Const vbErr_PathNotFound = 76
  Const INVALID_VALUE = -1
  Dim FileAttr As Long
  Dim FileName As String
  Dim hFind As Long
  Dim WFD As WIN32_FIND_DATA
  
  'Initialisierung:
  If Right$(Path, 1) <> "\" Then _
      Path = Path & "\"
  If Files Is Nothing Then _
      Set Files = New Collection
  Pattern = LCase$(Pattern)
  
  'Suche starten:
  hFind = FindFirstFileA(Path & "*", WFD)
  If hFind = INVALID_VALUE Then _
      Err.Raise vbErr_PathNotFound
  
  'Suche fortsetzen:
  Do
    FileName = LeftB$(WFD.cFileName, _
        InStrB(WFD.cFileName, vbNullChar))
    FileAttr = GetFileAttributesA(Path & FileName)
    
    If FileAttr And vbDirectory Then
    
      'Verzeichnis analysieren:
      If Recursive Then
        If FileAttr <> INVALID_VALUE _
            And FileName <> "." And FileName <> ".." _
        Then
          FindFiles = FindFiles + FindFiles( _
              Path & FileName, Files, Pattern, Attributes)
        End If
      End If
    
    Else
    
      'Datei analysieren:
      If (FileAttr And Attributes) = Attributes Then
        If LCase$(FileName) Like Pattern Then
          FindFiles = FindFiles + 1
          Files.Add Path & FileName
        End If
      End If
    
    End If
  Loop While FindNextFileA(hFind, WFD)
  FindClose hFind
End Function

-----------------------------------------------------------------------