Kontakt
DSVGO
Historie | |
---|---|
17.07.2003 | Tippfehler korrigiert |
05.05.2003 | Erste Version |
Sie wollen ein Verzeichnis (mitsamt Unterverzeichnisse) nach Dateien durchsuchen, welche bestimmte Wörter enthalten? Mit der unten gezeigten Routine ist dies kein Problem mehr...
Das folgende Code-Fragment durchforstet das komplette Laufwerk "C:" nach Text-Dateien, welche die Begriffe "VB" und "Tec" beinhalten (es wird also ein logisches "Und" verwendet) oder die Begriffe "Vietnam" und "Essen":
Dim c As Collection 'Trefferdateien Dim v As Variant 'Dateipfade FulltextSearch "C:\", "VB Tec", c, Recursive:=True) FulltextSearch "C:\", "Vietnam Essen", c, Recursive:=True) For Each v In c MsgBox "Trefferdatei: " & v Next vFile
Das logische "Oder" wird hier durch die Hintereinanderschaltung der FulltextSearch-Aufrufe realisiert, d.h. die Treffer-Collection füllt sich nach jedem Aufruf.
Der Code für die Suchroutine kann - trotz der ganzen Funktionalität - relativ kurz gehalten werden, da auf einige bereits bekannte Funktionen aus VB-Tec zurückgegriffen werden konnte (vgl. Links im Code).
Der Code ist recht einfach: Mittels FindFiles werden alle Kandidaten-Dateien gesammelt. Jede dieser Dateien wird mit ReadFile eingelesen, so dass durch wiederholtes InStr geprüft werden kann, ob alle Wörter enthalten sind...
' ©2003 by Jost Schwider, http://vb-tec.de/ Public Function FulltextSearch( _ ByRef Path As String, _ ByVal Words As Variant, _ ByRef Files As Collection, _ Optional ByVal Compare As VbCompareMethod = vbBinaryCompare, _ Optional ByVal Pattern As String = "*.*", _ Optional ByVal Attributes As VbFileAttribute = vbNormal, _ Optional ByVal Recursive As Boolean = False _ ) As Long Dim Candidates As Collection Dim File As Variant Dim Content As String Dim i As Long 'Ggf. Collection initialisieren: If Files Is Nothing Then _ Set Files = New Collection 'Ggf. String in Wörter-Array konvertieren: If VarType(Words) = vbString Then _ Words = Split(CStr(Words)) 'Los gehts: FindFiles Path, Candidates, Pattern, Attributes, Recursive For Each File In Candidates 'Datei einlesen: Content = ReadFile(CStr(File)) 'Wörter checken: For i = LBound(Words) To UBound(Words) If InStr(1, Content, CStr(Words(i)), Compare) = 0 Then i = 0 Exit For End If Next i 'Ggf. Treffer hinzufügen: If i > 0 Then _ Files.Add File Next File FulltextSearch = Files.Count End Function
© Jost Schwider, 05.05.2003-17.07.2003 - http://vb-tec.de/wortsuch.htm