'------- neue Logik PDF suchen -----------
'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
   
 '------- in txt-Datei speichern -----------
 'http://www.vbarchiv.net/tipps/tipp_301-textdateien-komfortabel-einlesen-und-schreiben.html
    Dim sFilename   As String       'sFilename:  vollständiger Dateiname
    Dim sLines      As String       'sLines   :  Inhalt, der gespeichert werden soll
    Dim F           As Integer
    
    'Datei zum Schreiben öffnen
    ZaehlerProtokoll = ZaehlerProtokoll + 1
    sFilename = "C:\1Arbeitsverzeichnis\Zu-Projekte-kopieren\Protokoll.txt"
    sLines = ZaehlerProtokoll & " " & Path
    F = FreeFile
    Open sFilename For Append As #F   ' und Textzeile ans Ende anfügen
    Print #F, sLines
    Close #F
'------- in txt-Datei speichern -----------
  
  'Initialisierung:
    If Right$(Path, 1) <> "\" Then
        Path = Path & "\"
    End If
    If Files Is Nothing Then
        Set Files = New Collection
    End If
    Pattern = LCase$(Pattern)
  
  'Suche starten:
    hFind = FindFirstFileA(Path & "*", WFD)
    If hFind = INVALID_VALUE Then
        Err.Raise vbErr_PathNotFound
    End If
  
  'Suche fortsetzen:
    Do
        FileName = LeftB$(WFD.cFileName, InStrB(WFD.cFileName, vbNullChar))
        FileAttr = GetFileAttributesA(Path & FileName)
    
'------- in txt-Datei speichern -----------
        sLines = ZaehlerProtokoll & " " & FileName
        Open sFilename For Append As #F   ' und Textzeile ans Ende anfügen
        Print #F, sLines
        Close #F
'------- in txt-Datei speichern -----------
    
        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