Keyword in verschiedenen xls Dateien suchen

Hallo erstmal,

dies ist mein erste Frage in diesem Forum, also falls ich was nicht
beachtet habe… weisst mich einfach darauf hin.

Meine Frage:

Ich habe ein Makro (von Reinhard) gefunden, es wäre genau das Makro
was ich für meine Aufgabe suche.
Ich möchte nach einem „Keyword“ in einem Verzeichnis (mit Unterver-
zeichnissen) in verschiedenen xls Dateien suchen. Wenn das Keyword
gefunden wurde, möchte ich gerne Wissen in welcher Datei sich das
Keyword befindet. Am besten gerade als Link, so dass ich nur noch auf
den Link klicken muss… um das File zu öffnen. Auch gut wäre, wenn
die ganze Zeile in der sich das Keyword befindet kopiert und in ein
leere Sheet kopiert wird (Idealfall).

Leider hat das jetzige Makro kleine Bugs, z.B. bekommt man keine
Meldung wenn das Keyword nicht vorhanden ist. Bei gefundenem Keyword
kommen mehrere Msgboxen mit Angabe gefunden, obwohl das nicht stimmt.
Dann muss mann alle Msgb. per klick schliessen.

Ich wäre sehr froh wenn mir jemand bei diesem Problem behilflich ist.

Hier der Code:

Sub tt()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error Resume Next
wort = InputBox(„Suchwort“)
Set fs = Application.FileSearch
With fs
.LookIn = „C:\test“
.Filename = „*.xls“
.Subfolder = True
.Execute
For i = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(i)
erg = Cells.Find(What:=wort, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
.Activate
If erg Then MsgBox wort & " gefunden in " & .FoundFiles(i)
Workbooks(Mid(.FoundFiles(i), InStrRev(.FoundFiles(i), „“) + 1)).Close SaveChanges:=False
Next i
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Gruss
Lanzma

a) :Leider hat das jetzige Makro kleine Bugs, z.B. bekommt man
 :keine Meldung wenn das Keyword nicht vorhanden ist. 
b) :Bei gefundenem Keyword kommen mehrere Msgboxen mit Angabe gefunden,
 :obwohl das nicht stimmt. Dann muss mann alle Msgb. per klick schliessen.

Hi Lanzma,
b) ich habe erstmal nur die Megboxen entfernt, es erscheint jetzt eine
 Lliste in A. Kann nicht nachvollziehen warum da Dateien gelistet
 werden die das Suchwert nicht enthalten!?

a) muss ich noch schauen

Sub tt()
Dim Wort, Erg, fs, i, zei
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error Resume Next
Wort = InputBox("Suchwort")
Set fs = Application.FileSearch
With fs
 .LookIn = "C:\test"
 .Filename = "\*.xls"
 .Subfolder = True
 .Execute
 For i = 1 To .FoundFiles.Count
 Workbooks.Open .FoundFiles(i)
 Erg = Cells.Find(What:=Wort, LookIn:=xlValues, LookAt:= \_
 xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) \_
 .Activate
 If Erg Then
 zei = zei + 1
 ThisWorkbook.ActiveSheet.Cells(zei, 1).Value = Wort & " gefunden in " & .FoundFiles(i)
 End If
 Workbooks(Mid(.FoundFiles(i), InStrRev(.FoundFiles(i), "\") + 1)).Close SaveChanges:=False
 Application.StatusBar = i & "/" & .FoundFiles.Count
 Next i
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


Gruß
Reinhard

Hi Reinhard,

ich danke Dir für den super Einsatz und hoffe das Du die Bugs
noch hinbekommst, werde morgen das ganze mal so richtig durchtesten.

coole Sache

danke
Lanzma

ich danke Dir für den super Einsatz und hoffe das Du die Bugs
noch hinbekommst, werde morgen das ganze mal so richtig
durchtesten.

Hi Lanzma,
habe jetzt den Code geändert, mir absolut unklar warum da einige Dateien aufgelistet wurden (ja, du hattest Recht*g) in denen garantiert nicht das Suchwort" ljpocropicjlvjc " steht.
Bei Erg=…
wenn ich da anstatt xlpart xlwhole benutze scheint es zu funktionieren, aber ich will ja auch nach Teilwörtern suchen .
Nach herausnahme von Activate scheint es zu klappen.
Hast du Dateien mit Kennwort, klappt das da?

Option Explicit

Sub tt()
Dim Wort, Erg, fs, i, zei, n
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error Resume Next
Wort = InputBox("Suchwort")
Set fs = Application.FileSearch
Columns(1).ClearContents
With fs
 .LookIn = "C:\test"
 .Filename = "\*.xls"
 .Subfolder = True
 .Execute
 For i = 1 To .FoundFiles.Count
 Workbooks.Open .FoundFiles(i)
 For n = 1 To ActiveWorkbook.Worksheets.Count
 Erg = ActiveWorkbook.Worksheets(n).Cells.Find(What:=Wort, LookIn:=xlValues, LookAt:= \_
 xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
 If Erg Then Exit For
 Next n
 If Erg Then
 zei = zei + 1
 ThisWorkbook.ActiveSheet.Cells(zei, 1).Value = Wort & " gefunden in " & .FoundFiles(i)
 End If
 Workbooks(Mid(.FoundFiles(i), InStrRev(.FoundFiles(i), "\") + 1)).Close SaveChanges:=False
 Application.StatusBar = i & "/" & .FoundFiles.Count
 Next i
End With
If zei = 0 Then Range("A1") = "Keine Dateine gefunden die das Suchwort " & Wort & " beinhalten"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Gruß
Reinhard

Hey Reinhard,

Pausenloser Einsatz *gg*, jep… scheint sauber zu laufen. Das mit den
Passwortgeschützen File werde ich morgen testen.
Das Interessante, die Files liegen alle auf einem Server… bin ja gespannt.

übrigends ist das ein super Makro… etwas commerzialisieren und Du wärst schwer reich *g*

bis dann
Lanzma

übrigends ist das ein super Makro… etwas commerzialisieren
und Du wärst schwer reich *g*

Hi Lanzma,
ach mir würds schon reichen meine Schulden wegzuhaben und davon leben zu können. Vor 4 Jahren stolperte ich über Excel, lernte dies und das dazu.
Seit einem Jahr habe ich die ernstliche Absicht mich auf kleinem Niveau in Excelproblemlösungen selbstständig zu machen. Kleines Niveau heisst, ich komme nicht auf den Gedanken für einen mit der französischen Tastatur in China den chinesischen Zeichensatz benutzenden Typen mit einem Mac auch nur irgendwelche programme zu schreben:smile:
Mein nicht unerfüllbarer Traum ist a) überhaupt die Selbständigkeit,
(warum heißt das nicht Selbst ständigkeit?)
b) morgens auszuschlafen, ich arbeite am PC gerne nachts
c) ausreichend viele kleine/mittlere Firmen an der Hand zu haben mit denen ich Verträge mit einer Monatspauschale habe dass ich alle*** Excelprobleme ihrer Mitarbeiter löse, ggfs spezielle Programme gegen Zusatzentgelt schreibe/pflege usw.

An sich wollte ich da schon dieses Jahr anfangen mich da zu bewerben bzw bestehende Kanäle die ich zu Firmen aus anderen Gründe habe zu nutzen aber sieht mehr nach nächstem Jahr aus, aber das macht nix, bis dahin bin ich noch nen Tick besser.

In einem andren Excelforum wo auch professionelle Auftragsprogrammierer, von denen ich unheimlich viel gelernt habe bei Ansicht ihrer Codes, Anfragen beantworten, ist es legitim kommerzielle Angebote zu machen, und da sit ne Anfrage einer Druckerei die ein Programm geschrieben habn möchte. Da bin ich am Ball, may be den Profis ist der Auftrag zu klein oder sie sind ausgelastet, ich nehm ihn mit Kusshand.
Gruß
Reinhard

*** fast alle :smile:

Hallo Reinhard,

tönt ja super was Du vor hast. Ich empfehle Dir dich bei grossen Firmen zu bewerben, wie z.B. Industrie / Pharma etc. all die Firmen verfügen über techn. Geräte, die extrem viele Daten generieren und um da noch Überlick zu haben und die Daten zu verarbeiten, sind so Leute wie Du „Willkommen“.

Ok, zurück zu dem Makro
a) wie Du erwähnt hast wenn ich z.B. „53“ suche findet und zeigt er
alle Keywörter mit „53“ an (also auch „MF53“, „O53“ etc.)
b) die Unterverzeichnisse werden nicht durchsucht, könnte man da
da nicht was auf der Basis von:

Excel.Application.GetOpenFilename() (Foldername)

einbauen, so könnte man das Verzeichniss auswählen und fertig.

So… muss ins Bett, sonst bekommt meine Frau wieder Anfälle.

Viele Grüsse und Danke
Lanzma

Hallo Reinhard

b) die Unterverzeichnisse werden nicht durchsucht

Ojee… mein Fehler, es heisst ja „SearchSubfolder“, das Du nichts
gemerkt hast *g*

Frage:

Kann man die Suchergebnisse auch erst in A3 anzeigen ?

Wenn kein Ergebnis vorhanden ist, ist es ja einfach
"If zei = 0 Then Range(„A3“)

aber bei Ergebnissen ??

Gruss