Private Declare Sub FindClose Lib "kernel32" (ByVal hFindFile As Long)
Private Declare Function FindFirstFileA Lib "kernel32" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFileA Lib "kernel32" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function GetFileAttributesA Lib "kernel32" (ByVal lpFileName As String) As Long
Private 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
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
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 = -1 Then
Err.Raise 76 'Verzeichnis nicht gefunden
End If
'Suche fortsetzen:
Do While FindNextFileA(hFind, WFD)
FileName = LeftB$(WFD.cFileName, _
InStrB(WFD.cFileName, vbNullChar))
FileAttr = GetFileAttributesA(Path & FileName)
If Not (FileAttr Or vbDirectory) Then
'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
FindClose hFind
End Function