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(ByVal Ordnerpfad As String, ByVal Suchbegriff As String)
 
 'Durchsucht alle Dateien in einem Ordner nach einem Suchbegriff
 'Late-Binding-Variante, kein Verweis "Microsoft Scripting Runtime" notwendig
 'Quelle: www.dbwiki.net oder www.dbwiki.de
 
 Dim FSO As Object       'Scripting.FileSystemObject
 Dim SF As Object        'Scripting.File
 Dim TS As Object        'Scripting.TextStream
 Dim strZeile As String
 Dim strDatei As String
 Dim strMeldung As String
 Const ForReading = 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 & "\"
 End If
 
 'Erste Datei im Ordner suchen
 strDatei = Dir(Ordnerpfad, vbNormal Or vbReadOnly Or vbHidden Or vbSystem)
 
 'Wenn mindestens eine Datei existiert
 If strDatei <> "" Then
 
   Do
      Set SF = FSO.GetFile(Ordnerpfad & strDatei)
      Set TS = SF.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
      Set TS = Nothing
      Set SF = Nothing
 
      'nächste Datei
      strDatei = Dir
 
   Loop Until strDatei = ""
 
 End If
 
 Set FSO = Nothing
 
 'Meldung ausgeben
 If strMeldung = "" Then
   MsgBox "Suchbegriff nicht gefunden."
 Else
   strMeldung = "Suchbegriff '" & Suchbegriff & "' gefunden in Datei " & strMeldung
   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 strLine As String, Chan As Integer, I As Long, strFName As String
With Application.FileSearch
  .LookIn = Pfad
  .FileName = "*.txt"
  .Execute
  For I = 1 To .FoundFiles.Count 'Schleife über Dateien
    strFName = .FoundFiles(I)
    Debug.Print strFName
    Chan = FreeFile()
    Open strFName For Input Access Read As #Chan
    Do Until EOF(Chan) 'Schleife in Datei
      Line Input #Chan, strLine
      If InStr(strLine, strSuch) > 0 Then ' Suchkriterium
        MsgBox "Gefunden in Datei '" & strFName & "'"
        Exit Do
      End If
    Loop
    Close #Chan
  Next I
End With
End Function

Aufruf

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

Web-Links