Volltextsuche Script lauffähig machen
09.05.2007 21:08:00
Mikey
Ich möchte eine Volltextsuche für externe Dateien in Excel bauen, die nach pdfs sucht, welche einen bestimmten Suchbegriff enthalten. Also eigentlich brauche ich nur die Anzahl der pdfs in denen der Begriff mindestens einmal vorkommt. Eine Linkliste zu den entsprechenden postiv Dateien wäre aber auch nicht schlecht.
Ich habe hier in diesem genialen Archiv einen Code von Ramses aus dem Jahr 2004 gefunden, der fast genau das macht, was ich machen möchte. In dem Beispiel wird eine Listbox in einer Userform mit allen Dateien, auf die das Suchkriterium zutrifft, gefüllt.
Ich weiß jetzt nicht, wie ich den Code zum Laufen kriegen kann. Mein Problem ist die Listbox. Ich habe bereits eine Userform eingefügt, und darin eine Listbox1 erstellt, das reicht aber scheinbar nicht.
Was muss ich also tun, damit die Suchabfrage läuft und mir am Ende eben diese ominöse Listbox füllt?
Fundstelle: https://www.herber.de/forum/archiv/384to388/t384134.htm:
Sub Find_Files_with_Textfragment()
Dim i As Long
Dim gefFile As String, dname As String
Dim Suchpfad As String, Suchbegriff As String, Dateiform As String
Dim oldStatus As Variant, myMatch As Boolean, msgTxt As String, Qe As Variant
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll:", "Pfad _
definieren", Application.DefaultFilePath)
If Suchpfad = "" Then Exit Sub
Dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung" _
_
, "*.xls")
If Dateiform = "" Then Exit Sub
Suchbegriff = InputBox("Geben Sie den Text an der in den Dateien gesucht werden soll", " _
Textfragment", "")
If Suchbegriff = "" Then Exit Sub
msgTxt = "Soll auf exakte Übereinstimmung mit dem Dateinamen gesucht werden ? "
msgTxt = msgTxt & vbCrLf & "Bei ""Nein"" werden als Ergebnis auch Dateien angezeigt,"
msgTxt = msgTxt & vbCrLf & "bei denen nur ein Teil des Namens mit:"" " & Suchbegriff & " "" _
_
übereinstimmt !"
Qe = MsgBox(msgTxt, vbQuestion + vbYesNo, "Suchroutine")
If Qe = vbOK Then
myMatch = True
Else
myMatch = False
End If
'Bildschirmaktualisier abschalten
Application.ScreenUpdating = True
'Text der Statusbar und alten Status aufnehmen
oldStatus = Application.StatusBar
'Start der Suchroutine
With Application.FileSearch
.NewSearch
.LookIn = Suchpfad
.TextOrProperty = Suchbegriff
.SearchSubFolders = True
' = True wenn der Suchbegriff GENAU übereinstimmen soll
' = False wenn nur ein Teil des Dateinamens übereinstimmen soll
.MatchTextExactly = myMatch
.FileType = Dateiform
If .Execute() > 0 Then
totFiles = .FoundFiles.count
'Ausgabe in Statusbar
Application.StatusBar = "Total " & totFiles & " gefunden"
For i = 1 To .FoundFiles.count
gefFile = .FoundFiles(i)
'In Listbox eintragen mit der AddItem Methode
Me.ListBox1.AddItem (gefFile)
Next i
End If
End With
End Sub