VBA Tipp: Textdatei durchsuchen

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

Ich möchte alle Dateien in einem Verzeichnis nach einem bestimmten Suchbegriff durchsuchen.

Lösung

Das geht mit dem FileSystemObject in folgender VBA-Prozedur, die in einem globalen Modul gespeichert wird.

Public Sub DateienDurchsuchen(Ordnerpfad As String, Suchbegriff As String)
 
   'Quelle: www.dbwiki.net oder www.dbwiki.de
   '
   'Durchsucht alle Dateien in einem Ordner nach einem Suchbegriff.
   'Late-Binding-Variante, kein Verweis "Microsoft Scripting Runtime" notwendig
 
   Dim fso          As Object       'Scripting.FileSystemObject
   Dim f            As Object       'Scripting.File
   Dim ts           As Object       'Scripting.TextStream
   Dim strZeile     As String
   Dim strDatei     As String
   Dim strMeldung   As String
 
   Const ForReading As Long = 1
 
   'Objektvariable mit dem FileSystemObject erstellen
   Set fso = CreateObject("Scripting.FileSystemObject")
 
   'Backslash am Ende des Pfads hinzufügen, falls er fehlt
   If Right$(Ordnerpfad, 1) <> "\" Then Ordnerpfad = Ordnerpfad & "\"
 
   'Erste Datei im Ordner suchen
   strDatei = Dir(Ordnerpfad, vbNormal Or vbReadOnly Or vbHidden Or vbSystem)
 
   'Wenn mindestens eine Datei existiert
   If strDatei <> vbNullString Then
      Do
         Set f = fso.GetFile(Ordnerpfad & strDatei)
         Set ts = f.OpenAsTextStream(ForReading)
 
         Do
            strZeile = ts.ReadLine
 
            'in jeder Zeile nach dem Suchbegriff suchen
            If InStr(strZeile, Suchbegriff) > 0 Then
               strMeldung = strMeldung & vbCrLf & strDatei
            End If
         Loop Until ts.AtEndOfStream
 
         ts.Close
 
         'nächste Datei
         strDatei = Dir
 
      Loop Until strDatei = vbNullString
   End If
 
   'Meldung ausgeben
   If Len(strMeldung) = 0 Then
      MsgBox "Suchbegriff nicht gefunden."
   Else
      strMeldung = "Suchbegriff: '" & Suchbegriff & "' in Datei '" & _
                   strMeldung & "' gefunden."
      MsgBox strMeldung
   End If
 
End Sub

Aufruf

   Call DateienDurchsuchen(CurrentProject.Path, "MeinSuchbegriff")

Lösung (bis Access 2003)

Hinweis: Die Funktion Application.FileSearch gibt es ab Access 2007 nicht mehr.

Public Function Dateisuche(Pfad As String, strSuch As String)
   Dim strFName As String
   Dim strLine  As String
   Dim fNum     As Integer
   Dim i        As Long
 
   With FileSearch
      .LookIn = Pfad
      .FileName = "*.txt"
      .Execute
      For i = 1 To .FoundFiles.Count   'Schleife über Dateien
         strFName = .FoundFiles(i)
         Debug.Print strFName
         fNum = FreeFile()
         Open strFName For Input Access Read As fNum
         Do Until EOF(fNum)   'Schleife in Datei
            Line Input #fNum, strLine
            If InStr(strLine, strSuch) > 0 Then   ' Suchkriterium
               MsgBox "Gefunden in Datei '" & strFName & "'"
               Exit Do
            End If
         Loop
         Close fNum
      Next
   End With
End Function

Aufruf

   'Wenn vorhanden, erscheint eine MsgBox:
   Call Dateisuche("C:\MeineDATEN\","Hundekuchen")

Web-Links