Stringsuche in Datei mit VBA

Dateiinhalte suchen und Dateiname mit Pfad ausgeben

Hallo zusammen,

bin seit geraumer Zeit auf der Suche nach ner Lösung.
Habe einen Suchcode der mir supergut die Dateien findet und auch anzeigt, das Problem ist, das ich in die Suche den korrekten Dateinnamen eingeben muss.
Was ich aber brauche ist das er mit nach Dateiinhalten sucht. Also quasi die Desktopsuche von MS.
Habe es über SearchFile versucht - das klappt auch - nur leider nur in Office 2003. Ab 2007 gibts SearchFile nicht mehr

Hat jemand ne Lösung wie ich unten angegebenen Code so umwandle das er mit die gesamte Datei nach Inhalt nach Textinhalten durchsucht?


Option Explicit

Dim fso As New FileSystemObject
Dim fld As Folder

Private Sub cmdFSuchen_Click()
Dim nDirs As Long, nFiles As Long, lSize As Currency
Dim sDir As String, sSrchString As String
Dim fText As String


ListBox1.Clear
sDir = "c:\test\"
fText = TextBox1
'MousePointer = vbHourglass
Label1.Caption = "Searching " & vbCrLf & UCase(sDir) & "..."
lSize = FindFile(sDir, fText, nDirs, nFiles)
'MousePointer = vbDefault
MsgBox Str(nFiles) & " " & " Dateien mit dem Namen " & sSrchString & " gefunden in" & Str(nDirs) & _
" Verzeichnis", vbInformation
'MsgBox "Total Size = " & lSize & " bytes"
End Sub

Private Function FindFile(ByVal sFol As String, sFile As String, _
nDirs As Long, nFiles As Long) As Currency
Dim tFld As Folder, tFil As File, FileName As String
Dim fText As String
On Error GoTo Catch
Set fld = fso.GetFolder(sFol)
FileName = dir(fso.BuildPath(fld.path, sFile), vbNormal Or _
vbHidden Or vbSystem Or vbReadOnly)
While Len(FileName) <> 0
FindFile = FindFile + FileLen(fso.BuildPath(fld.path, _
FileName))
nFiles = nFiles + 1
ListBox1.AddItem fso.BuildPath(fld.path, dir) ' Load ListBox
FileName = dir() ' Get next file
DoEvents
Wend
Label1 = "Searching " & vbCrLf & fld.path & "..."
nDirs = nDirs + 1
If fld.SubFolders.Count > 0 Then
For Each tFld In fld.SubFolders
DoEvents
FindFile = FindFile + FindFile(tFld.path, sFile, nDirs, nFiles)
Next
End If
Exit Function
Catch: FileName = ""
Resume Next
End Function

Private Sub CommandButton2_Click()
Unload frmOrdnerSuchen
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim dir As String
dir = ListBox1
Shell "explorer.exe " & dir, vbNormalFocus

End Sub


Danke und Gruß Manuel

Pfad = "c:\test\*.txt"  
Suchbegriff = "Dein Text"  
Set objShell = CreateObject("WScript.Shell")  
Set objExecObject = objShell.Exec("%comspec% /c findstr /m /s /c:""" & Suchbegriff & """ """ & Pfad & """")  
i = 1
If Not objExecObject.StdOut.AtEndOfStream Then
    FileList = Split(Trim(objExecObject.StdOut.ReadAll()), vbCrLf)
    For i = 0 To UBound(FileList) - 1
        listbox.AddItem FileList(i)
    Next
End If

Pfad = "c:\test\*.*"  
Suchbegriff = "Langen"  
Set objShell = CreateObject("WScript.Shell")  
CommandLine = "%comspec% /c findstr /m /s /i /c:""" & Suchbegriff & """ """ & Pfad & """"  
Dummy = InputBox("CommandLine", , CommandLine)  

Set objExecObject = objShell.Exec(CommandLine)
If Not objExecObject.StdOut.AtEndOfStream Then
    FileList = Split(Trim(objExecObject.StdOut.ReadAll()), vbCrLf)
    For i = 0 To UBound(FileList) - 1
        ListBox1.AddItem FileList(i)
    Next
End If

CommandLine = "%comspec% /c findstr /m /s /i /c:""" & Suchbegriff & """ """ & Pfad & """ >%temp%\Dateiliste.txt"  

PathOnly = Left(Pfad, InStrRev(Pfad, "\"))