Hallo Rainer,
anbei poste ich Dir hier einmal die geaenderte Version der Klasse zum durchsuchen nach Dateien und deren Inhalt.
Schaue Dir mal bitte die geaenderte Version an. Ich habe auf die schnelle da mal die Option rein geprüügelt das nun auch der Dateiinhalt mit durchsucht wird. Das kann man optional einstellen. Dazu sind zwei weitere Eigenschaften implementiert
'Eigenschaft
SearchText = Soll in dem gefundenen File nach einem String gesucht werden
TextToFind = Text der in der Datei gesucht werden soll ( SearchText muss dazu auf True gesetzt werden!)
Die Suche findet in der Function FileContent statt. Schaue da mal bitte inwiefern man das noch optimieren kann. Ich hab da nur eine 0815 Lösung gemacht 
Wenn du das dann noch testen könntest waere ich Dir dankbar. Wenn wir dann die lauffaehige Version haben, so koennen wir die doch dann in die FAQ schieben und die alte version dann löschen 
MfG Alex
'Das Klassenmodul cFindFile
Option Explicit
' Benötigte API´s
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" \_
(ByVal lpFileName As String, \_
lpFindFileData As WIN32\_FIND\_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" \_
(ByVal hFindFile As Long, \_
lpFindFileData As WIN32\_FIND\_DATA) As Long
Private Declare Function FindClose Lib "kernel32" \_
(ByVal hFindFile As Long) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" \_
(lpFileTime As FILETIME, \_
lpSystemTime As SYSTEMTIME) As Long
' Benutzerdefinierte Konstanten
Private Const MAX\_PATH = 260
Private Const MAXDWORD = &HFFFF
Private Const INVALID\_HANDLE\_VALUE = -1
Private Const MyUnhandledError = 9999
' Benutzerdefinierte Typen
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
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 \* MAX\_PATH
cAlternate As String \* 14
End Type
' Aufzählung für sFileFlag Eigenschaft
Public Enum FileFlag
FILE\_ATTRIBUTE\_READONLY = &H1
FILE\_ATTRIBUTE\_HIDDEN = &H2
FILE\_ATTRIBUTE\_SYSTEM = &H4
FILE\_ATTRIBUTE\_DIRECTORY = &H10
FILE\_ATTRIBUTE\_ARCHIVE = &H20
FILE\_ATTRIBUTE\_NORMAL = &H80
FILE\_ATTRIBUTE\_TEMPORARY = &H100
FILE\_ATTRIBUTE\_ALLTYPES = &H1B7
FILE\_ATTRIBUTE\_ALLTYPES\_WITHOUT\_DIR = &H1A7
End Enum
'lokale Variablen zum Zuweisen der Eigenschaften
Private mvarsSearchpath As String
Private mvarsFileToFind As String
Private mvarsInclSubfolders As Boolean
Private mvarsFileFlag As FileFlag
Private mvarsSearchText As Boolean
Private mvarsTextToFind As String
'RaiseEvent MatchFound[(arg1, arg2, ... , argn)]
Public Event MatchFound(ByVal sFilename As String, \_
ByVal sFilePath As String, \_
ByVal sFiledate As Date, \_
ByVal sFilesize As Long, \_
ByVal sLastAccess As Date, \_
ByVal sLastWrite As Date, \_
ByVal sShortName As String)
'RaiseEvent StopSearch[(arg1)]
Public Event StopSearch(Cancel As Boolean)
Private Sub Class\_Initialize()
'Die Klasse wird initialisiert.
sFileFlag = FILE\_ATTRIBUTE\_ALLTYPES
sInclSubfolders = True
End Sub
Private Sub Class\_Terminate()
'Die Klasse wird aus dem Speicher entfernt.
End Sub
Public Sub sStartSearch()
Dim lFileToFind As String, lSearchpath As String, FileName As String
Dim ShortName As String, DirName As String, DirNames() As String
Dim DirCount As Integer, nDir As Integer, Cont As Integer, I As Integer
Dim Filesize As Long, hSearch As Long
Dim Filedate As Date, LastAccess As Date, LastWrite As Date
Dim lInclSubfolders As Boolean, bCancel As Boolean
Dim sDate As SYSTEMTIME
Dim lFileFlag As FileFlag
Dim WFD As WIN32\_FIND\_DATA
On Error GoTo sStartSearchErr
' Eigenschaften Property Get in lokale Variablen kopieren
lFileToFind = sFileToFind
lFileFlag = sFileFlag
lSearchpath = sSearchpath
lInclSubfolders = sInclSubfolders
' Initialisieren der Variablen
If Right(lSearchpath, 1) "\" Then lSearchpath = lSearchpath & "\"
nDir = 0
DirCount = 0
ReDim DirNames(nDir)
Cont = True
bCancel = False
' Die Suche geht los. Zuerst werden die Subfolders ermittelt
hSearch = FindFirstFile(lSearchpath & "\*", WFD)
If hSearch INVALID\_HANDLE\_VALUE Then
Do While Cont
' vbNullChar entfernen
DirName = Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
' Prüfen, ob DirName auch wirklich ein Subfolder ist
If (DirName ".") And (DirName "..") Then
If (WFD.dwFileAttributes And vbDirectory) = FileFlag.FILE\_ATTRIBUTE\_DIRECTORY Then
' Subfolder ins loakale Array speichern
DirNames(nDir) = DirName
' Schleifenzähler erhöhen
DirCount = DirCount + 1
nDir = nDir + 1
' Lokales Array neu dimensionieren
ReDim Preserve DirNames(nDir)
End If
End If
' Nächster Subfolder ermitteln
Cont = FindNextFile(hSearch, WFD)
' Geben wir der Methode ein wenig Zeit zum Atmen
DoEvents
Loop
Cont = FindClose(hSearch)
End If
' Jetzt werden die zu findenden Dateien ermittelt
hSearch = FindFirstFile(lSearchpath & lFileToFind, WFD)
Cont = True
If hSearch INVALID\_HANDLE\_VALUE Then
While Cont
' vbNullChar entfernen
FileName = Left$(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
' Prüfen, ob FileName ungleich . und .. ist
If (FileName ".") And (FileName "..") Then
' Stimmt das FileAttribut mit Eigenschaft sFileFlag überein und stimmt der Inhalt der Datei
If ((WFD.dwFileAttributes Or lFileFlag) = lFileFlag) And FileContent(lSearchpath & FileName) Then
' Dateigröße ermitteln
Filesize = (WFD.nFileSizeHigh \* MAXDWORD) + WFD.nFileSizeLow
' Dateidatum/Zeit ermitteln
FileTimeToSystemTime WFD.ftCreationTime, sDate
With sDate
Filedate = CDate(.wDay & "." & .wMonth & "." & .wYear \_
& " " & .wHour & ":" & .wMinute & ":" & .wSecond)
End With
' LastAccess ermitteln
FileTimeToSystemTime WFD.ftLastAccessTime, sDate
With sDate
LastAccess = CDate(.wDay & "." & .wMonth & "." & .wYear \_
& " " & .wHour & ":" & .wMinute & ":" & .wSecond)
End With
' LastWrite ermitteln
FileTimeToSystemTime WFD.ftLastWriteTime, sDate
With sDate
LastWrite = CDate(.wDay & "." & .wMonth & "." & .wYear \_
& " " & .wHour & ":" & .wMinute & ":" & .wSecond)
End With
' ShortName 8.3 ermitteln
ShortName = Left$(WFD.cAlternate, InStr(WFD.cAlternate, vbNullChar) - 1)
' Und jetzt den Event aufrufen um die Dateiinformationen zu übergeben
RaiseEvent MatchFound(FileName, lSearchpath, Filedate, Filesize, \_
LastAccess, LastWrite, ShortName)
End If
End If
' Nächste Datei ermitteln
Cont = FindNextFile(hSearch, WFD)
' Geben wir der Methode ein wenig Zeit zum Atmen
DoEvents
Wend
' Suche abgeschlossen
Cont = FindClose(hSearch)
End If
' Sollen die Subfolders durchsucht werden?
If lInclSubfolders Then
' Prüfen, ob im aktuellen Folder weitere Subfolder sind
If nDir \> 0 Then
' Rekursiver Aufruf der Methode mit Übergabe eines neuen Subfolders
For I = 0 To nDir - 1
' Event StopSearch aufrufen und prüfen ob Abbruch
' durch Benutzer erfolgte
RaiseEvent StopSearch(bCancel)
If bCancel Then Exit Sub
' neuer Suchpfad an Property Let sSearchpath übergeben
sSearchpath = lSearchpath & DirNames(I)
' neue Suche starten...
sStartSearch
Next I
End If
End If
Exit Sub
sStartSearchErr:
RaiseError MyUnhandledError, "cFindFile:sStartSearch Method" \_
, "Fehler bei sStartSearch"
End Sub
'Existiert die Datei
Private Function FileExists(sFile As String) As Boolean
On Error Resume Next
GetAttr (sFile)
FileExists = (Err.Number = 0)
End Function
'Stimmt der Inhalt
Private Function FileContent(sFile As String) As Boolean
On Error Resume Next
Dim fNr As Byte
Dim vRet As String
Dim Pos As Long
FileContent = True
If (mvarsSearchText = False) Or (Trim(mvarsTextToFind) = "") Then Exit Function
If Not FileExists(sFile) Then
FileContent = False
Exit Function
End If
If GetAttr(sFile) = vbDirectory Then
FileContent = False
Exit Function
End If
fNr = FreeFile
Open sFile For Input As #fNr
vRet = Input(LOF(fNr), fNr)
Close fNr
Pos = InStr(vRet, mvarsTextToFind)
FileContent = CBool(Pos \> 0)
End Function
' Eigenschaft cFindFile.sFileFlag setzen
Public Property Let sFileFlag(ByVal vData As FileFlag)
On Error GoTo sFileFlagLetErr
mvarsFileFlag = vData
Exit Property
sFileFlagLetErr:
RaiseError MyUnhandledError, "cFindFile:sFileFlag Property Let" \_
, "Fehler bei sFileFlag Property Let"
End Property
' Eigenschaft cFindFile.sFileFlag lesen
Public Property Get sFileFlag() As FileFlag
On Error GoTo sFileFlagGetErr
sFileFlag = mvarsFileFlag
Exit Property
sFileFlagGetErr:
RaiseError MyUnhandledError, "cFindFile:sFileFlag Property Get" \_
, "Fehler bei sFileFlag Property Get"
End Property
' Eigenschaft cFindFile.sInclSubFolders setzen
Public Property Let sInclSubfolders(ByVal vData As Boolean)
On Error GoTo sInclSubfoldersLetErr
mvarsInclSubfolders = vData
Exit Property
sInclSubfoldersLetErr:
RaiseError MyUnhandledError, "cFindFile:sInclSubfolders Property Let" \_
, "Fehler bei sInclSubfolders Property Let"
End Property
' Eigenschaft cFindFile.sInclSubFolders lesen
Public Property Get sInclSubfolders() As Boolean
On Error GoTo sInclSubfoldersGetErr
sInclSubfolders = mvarsInclSubfolders
Exit Property
sInclSubfoldersGetErr:
RaiseError MyUnhandledError, "cFindFile:sInclSubfolders Property Get" \_
, "Fehler bei sInclSubfolders Property Get"
End Property
' Eigenschaft cFindFile.sFileToFind setzen
Public Property Let sFileToFind(ByVal vData As String)
On Error GoTo sFileToFindLetErr
mvarsFileToFind = vData
Exit Property
sFileToFindLetErr:
RaiseError MyUnhandledError, "cFindFile:sFileToFind Property Let" \_
, "Fehler bei sFileToFind Property Let"
End Property
' Eigenschaft cFindFile.sFileToFind lesen
Public Property Get sFileToFind() As String
On Error GoTo sFileToFindGetErr
sFileToFind = mvarsFileToFind
Exit Property
sFileToFindGetErr:
RaiseError MyUnhandledError, "cFindFile:sFileToFind Property Get" \_
, "Fehler bei sFileToFind Property Get"
End Property
' Eigenschaft cFindFile.sSearchpath setzen
Public Property Let sSearchpath(ByVal vData As String)
On Error GoTo sSearchpathLetErr
mvarsSearchpath = vData
Exit Property
sSearchpathLetErr:
RaiseError MyUnhandledError, "cFindFile:sSearchpath Property Let" \_
, "Fehler bei sSearchpath Property Let"
End Property
' Eigenschaft cFindFile.sSearchpath lesen
Public Property Get sSearchpath() As String
On Error GoTo sSearchpathGetErr
sSearchpath = mvarsSearchpath
Exit Property
sSearchpathGetErr:
RaiseError MyUnhandledError, "cFindFile:sSearchpath Property Get" \_
, "Fehler bei sSearchpath Property Get"
End Property
'Eigenschaft cFindFile.sSearchText setzen
Public Property Let sSearchText(ByVal vData As Boolean)
On Error GoTo sSearchTextLetErr
mvarsSearchText = vData
Exit Property
sSearchTextLetErr:
RaiseError MyUnhandledError, "cFindFile:sSearchText Property Let" \_
, "Fehler bei sSearchText Property Let"
End Property
'Eigenschaft cFindFile.sSearchText lesen
Public Property Get sSearchText() As Boolean
On Error GoTo sSearchTextGetErr
sSearchText = mvarsSearchText
Exit Property
sSearchTextGetErr:
RaiseError MyUnhandledError, "cFindFile:sSearchText Property Get" \_
, "Fehler bei sSearchText Property Get"
End Property
'Eigenschaft cFindFile.sTextToFind setzen
Public Property Let sTextToFind(ByVal vData As String)
On Error GoTo sTextToFindLetErr
mvarsTextToFind = vData
Exit Property
sTextToFindLetErr:
RaiseError MyUnhandledError, "cFindFile:sTextToFind Property Let" \_
, "Fehler bei sTextToFind Property Let"
End Property
'Eigenschaft cFindFile.sTextToFind lesen
Public Property Get sTextToFind() As String
On Error GoTo sTextToFindGetErr
sTextToFind = mvarsTextToFind
Exit Property
sTextToFindGetErr:
RaiseError MyUnhandledError, "cFindFile:sTextToFind Property Get" \_
, "Fehler bei sTextToFind Property Get"
End Property
' Error Object setzen und an den Client übergeben
Private Sub RaiseError(ErrorNumber As Long, Source As String, strErrorText As String)
Err.Raise ErrorNumber, Source, strErrorText
End Sub
Der Aufruf würde nun wiefolgt ausschauen.
Option Explicit
Private WithEvents Search As cFindFile
Private Cancel As Boolean
Private Sub CommandButton1\_Click()
Cancel = False
Set Search = New cFindFile
With Search
.sFileFlag = FILE\_ATTRIBUTE\_ALLTYPES\_WITHOUT\_DIR
.sFileToFind = "\*.\*"
.sInclSubfolders = True
.sSearchpath = "c:\"
.sSearchText = True
.sTextToFind = "DeinSuchkriterium"
.sStartSearch
End With
End Sub
Private Sub Search\_MatchFound(ByVal sFilename As String, ByVal sFilePath As String, ByVal sFiledate As Date, ByVal sFilesize As Long, ByVal sLastAccess As Date, ByVal sLastWrite As Date, ByVal sShortName As String)
MsgBox sFilename
End Sub
