*.xls Dateien mit Makro nach Begriff durchsuchen

Sub dateien_durchsuchen_Click() Application.DisplayAlerts = False Application.ScreenUpdating = False On Error Resume Next wort = InputBox("Suchwort") Set fs = Application.FileSearch With fs .LookIn = "\\192.168...\HakC\exceldateien" .Filename = "*.xls" .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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub dateien_durchsuchen_Click() Dim wort$, fs As FileSearch, i%, efz%, wsA As Worksheet, wb As Workbook, ws As Worksheet, _ erg As Range Application.DisplayAlerts = False Application.ScreenUpdating = False On Error Resume Next Application.DisplayAlerts = False ThisWorkbook.Worksheets("Auswahl").Delete Application.DisplayAlerts = True ThisWorkbook.Worksheets.Add.Name = "Auswahl" Set wsA = ActiveWorkbook.Worksheets(1) wort = InputBox("Suchwort") Set fs = Application.FileSearch With fs ' .LookIn = "\\192.168...\HakC\exceldateien" .LookIn = "C:\Daten\Excel\1Projekte\FileTransfer_Allgemein" .Filename = "*.xls" .SearchSubFolders = False .Execute wsA.Range("A1").Value = " wurde in folgenden Dateien gefunden:" wsA.Rows(1).Font.Bold = True wsA.Range("B1").Value = "Dateiname" wsA.Range("C1").Value = "1.Fundzelle" For i = 1 To .FoundFiles.Count Workbooks.Open .FoundFiles(i) Set wb = ActiveWorkbook Set ws = ActiveSheet Set erg = Cells.Find(What:=wort, LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) If Not erg Is Nothing Then efz = wsA.Cells(Rows.Count, 1).End(xlUp).Row + 1 wsA.Cells(efz, 1).Value = .FoundFiles(i) wsA.Cells(efz, 2).Value = Dir(.FoundFiles(i)) wsA.Cells(efz, 3).Value = erg.Address End If wb.Close False Next i End With wsA.Columns.AutoFit Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub

For i = 1 To .FoundFiles.Count If Dir(.FoundFiles(i)) ThisWorkbook.Name Then Workbooks.Open .FoundFiles(i) Set wb = ActiveWorkbook Set ws = ActiveSheet Set erg = Cells.Find(What:=wort, LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) If Not erg Is Nothing Then efz = wsA.Cells(Rows.Count, 1).End(xlUp).Row + 1 wsA.Cells(efz, 1).Value = .FoundFiles(i) wsA.Cells(efz, 2).Value = Dir(.FoundFiles(i)) wsA.Cells(efz, 3).Value = erg.Address End If wb.Close False End If Next i

Hallo Heinz (und alle anderen)!
Das mit der Updateabfrage hat wunderbar geklappt --> VIELEN VIELEN DANK!!!
Eigentlich waere mein Programm jetzt auch fertig gewesen, aber wie das so ist habe ich direkt ein naechstes Problem gefunden, welches allerdings gravierend ist, da deswegen mein Programm nicht wirklich funktionsfaehig ist...
Folgendes Problem:
Das von euch verbesserte Programm macht eingentlich alles was ich will, allerdings funktioniert die Suche nicht richtig! Wenn ich als Suchbegriff "Produkt 1" eingebe, sehe ich, wie er alle Dateien meines Zielordners oeffnet (was zeigt, dass diese durchsucht werden), allerdings tauchen in der Fundliste (die Liste mit den gefundenen Dateien) alle Dateien des Ordners auf, also auch wenn sie den Begriff "Produkt 1" gar nicht beinhalten!
Als Fundstelle gibt Excel auch jedes mal die selbe Zelle an (das Wort "Produkt" steht auch jedes Mal in der selben Zelle, allerdings mit anderen Zahlen dahinter).
Das Wort "Produkt" kommt jeder Datei vor, allerdings will ich nicht, dass Excel mir Dateien, in denen "Produkt 2" steht, ausgibt (schliesslich Suche ich ja nach "Produkt 1").
Suche ich nun nach dem Begriff "Produkt 2", findet Excel keine einzige Datei, obwohl es welche gibt, welche diesen Namen in einer Zelle stehen haben.
Zusammengefasst:
Entweder es werden falsche Dateien gefunden, die den Suchbegriff nicht enthalten, oder es werden gar keine Dateien gefunden, obwohl garantiert welche den gewuenschten Begriff enthalten.
Gibt es dafuer eine logische Erklaerung?
Kann man das aendern?
Wenn ich die Suche auf eine Spalte reduziere (also dass Excel immer nur eine Spalte durchsucht und nicht die ganze Datei), haette das evtl. einen Einfluss auf das Ergebnis?
Wuerde mich sehr ueber Anregungen freuen! Vielen Dank
MfG
Chris
Hier der aktuelle Code:


Sub dateien_durchsuchen_Click()
Dim wort$, fs As FileSearch, i%, efz%, wsA As Worksheet, wb As Workbook, ws As Worksheet, _
erg As Range
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.AskToUpdateLinks = False
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Auswahl").Delete
Application.DisplayAlerts = True
ThisWorkbook.Worksheets.Add.Name = "Auswahl"
Set wsA = ActiveWorkbook.Worksheets(1)
wort = InputBox("Suchwort")
If wort = "" Then Exit Sub
Set fs = Application.FileSearch
With fs
.LookIn = "\\192.168.5....\HakC\exceldateien"
.Filename = "*.xls"
.SearchSubFolders = False
.Execute
wsA.Range("A1").Value = " wurde in folgenden Dateien gefunden:"
wsA.Rows(1).Font.Bold = True
wsA.Range("B1").Value = "Dateiname"
wsA.Range("C1").Value = "1.Fundzelle"
For i = 1 To .FoundFiles.Count
If Dir(.FoundFiles(i))  ThisWorkbook.Name Then
Workbooks.Open .FoundFiles(i)
Set wb = ActiveWorkbook
Set ws = ActiveSheet
Set erg = Cells.Find(What:=wort, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not erg Is Nothing Then
efz = wsA.Cells(Rows.Count, 1).End(xlUp).Row + 1
wsA.Cells(efz, 1).Value = .FoundFiles(i)
wsA.Cells(efz, 2).Value = Dir(.FoundFiles(i))
wsA.Cells(efz, 3).Value = erg.Address
End If
wb.Close False
End If
Next i
End With
wsA.Columns.AutoFit
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.AskToUpdateLinks = True
End Sub

Hallo Heinz!
Ich glaube ich weiss jetzt, was mein Problem ist...
Und zwar ist die Spalte (es reicht tatsaechlich immer nur eine Spalte ("D") zu durchsuchen) mit Dropdown-Menues gefuellt.
Erschwerend ist dann noch, dass sich diese Dropdown-Menues auf eine andere Exceldatei beziehen, welche immer geoeffnet sein muss, da sonst die Dropdown-Menues nicht funktionieren.
Suche ich nun mit dem Suchprogramm nach einem Wort, welches sich nicht in der Dropdownliste, sondern voellig normal in einer Zelle (ohne Funktionen) in der Datei befindet, findet das Programm die richitgen Dateien (in der Fundliste sind also die korrekten Ergebnisse vermerkt).
Suche ich aber nach einem Begriff, welcher sich in der Dropdownlisten-Zelle befindet (diese Zelle ist natuerlich nicht leer, d.h. es ist z.B. "Produkt 2", "Produkt 3", etc. ausgewaehlt), dann kommen wieder keine/falsche Ergebnisse in der Fundliste raus (ausser ich suche nach dem ersten (obersten) Wert der Dropdownliste, also nach "Produkt 1").
Das heisst, dass das Suchprogramm jedes mal den ersten Wert der Dropdownliste (hier: "Produkt 1") in der Zelle findet, auch wenn in Wirklichkeit "Produkt 2", "Produkt 3", etc. ausgewaehlt sind.
Zusammengefasst:
Das Suchprogramm reduziert die Werte der Spalte "D" auf das erste Auswahlkriterium der Dropdownliste, auch wenn dieses gar nicht ausgewaehlt ist.
Vermutung:
Ich denke, das liegt entweder an der Tatsache, dass es eine Dropdownliste ist
oder, dass sich die Dropdownliste auf eine andere Datei bezieht
Loesungsidee:
Dass sich die Dropdownliste auf eine andere Datei bezieht koennte ich aendern, indem ich die Bezugsdatei (eine Datenbank, welche "Produkt 1", "Produkt 2", etc. und dazugehoerige Daten beinhaltet) auf ein neues "Sheet" innerhalb der Datei ziehe, sodass sich die Dropdownliste auf ein Blatt in der eigenen Datei bezieht.
Problem:
1. Ich weiss nicht, ob so das Problem wirklich behoben wird
2. Ich muesste in das Suchprogramm eine Einschraenkung integrieren, dass wirklich nur die Spalte "D" auf dem ersten Blatt ("Sheet 1") durchsucht wird, da sonst immer alle Dateien in der Fundliste auftauchen, da die Datenbank sich dann innerhalb der Datei befindet
3. Das ist mit meinen Kenntnissen leider nicht moeglich :-(
Haettest Du / Ihr eine Idee, wie das geht und weisst Du / Ihr, ob das wirklich das Problem mit den falschen Suchergebnissen behebt, denn wenn es einfach nur daran liegt, dass Zellen mit Dropdownlisten nicht ordentlich durchsucht werden koennen, bringt meine Loesungsidee nichts, da die Dropdownliste dann immernoch vorhanden ist (und auch sein muss!) ?
VIELEN HERZLICHEN DANK FUER DIE BEMUEHUNGEN!!!!!!!!!!!
VIELEN HERZLICHEN DANK FUER DIE BEMUEHUNGEN!!!!!!!!!!!
MfG
Chris

Sub dateien_durchsuchen_Click() Dim wort$, fs As FileSearch, i%, efz% Dim wsA As Worksheet, wb As Workbook, ws As Worksheet, erg As Range Application.DisplayAlerts = False Application.ScreenUpdating = False Application.AskToUpdateLinks = False On Error Resume Next Application.DisplayAlerts = False ThisWorkbook.Worksheets("Auswahl").Delete Application.DisplayAlerts = True ThisWorkbook.Worksheets.Add.Name = "Auswahl" Set wsA = ActiveWorkbook.Worksheets(1) wort = InputBox("Suchwort") If wort = "" Then Exit Sub Set fs = Application.FileSearch With fs .LookIn = "\\192.168.5....\HakC\exceldateien" .Filename = "*.xls" .SearchSubFolders = False .Execute wsA.Range("A1").Value = " wurde in folgenden Dateien gefunden:" wsA.Rows(1).Font.Bold = True wsA.Range("B1").Value = "Dateiname" wsA.Range("C1").Value = "1.Fundzelle" For i = 1 To .FoundFiles.Count If Dir(.FoundFiles(i)) ThisWorkbook.Name Then Workbooks.Open .FoundFiles(i) Set wb = ActiveWorkbook Set ws = ActiveSheet Set erg = ws.Columns("D:D").Find(What:=wort, LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) If Not erg Is Nothing Then efz = wsA.Cells(Rows.Count, 1).End(xlUp).Row + 1 wsA.Cells(efz, 1).Value = .FoundFiles(i) wsA.Cells(efz, 2).Value = Dir(.FoundFiles(i)) wsA.Cells(efz, 3).Value = erg.Address End If wb.Close False End If Next i End With wsA.Columns.AutoFit Application.DisplayAlerts = True Application.ScreenUpdating = True Application.AskToUpdateLinks = True End Sub

Sub dateien_durchsuchen_Click() Dim wort$, fs As FileSearch, i%, efz% Dim wsA As Worksheet, wb As Workbook, ws As Worksheet, erg As Range Application.DisplayAlerts = False Application.ScreenUpdating = False Application.AskToUpdateLinks = False wort = InputBox("Suchwort") If wort = "" Then Exit Sub On Error Resume Next Application.DisplayAlerts = False ThisWorkbook.Worksheets("Auswahl").Delete Application.DisplayAlerts = True ThisWorkbook.Worksheets.Add.Name = "Auswahl" Set wsA = ActiveWorkbook.Worksheets(1) Set fs = Application.FileSearch With fs .LookIn = "\\192.168.5....\HakC\exceldateien" .Filename = "*.xls" .SearchSubFolders = False .Execute wsA.Range("A1").Value = " wurde in folgenden Dateien gefunden:" wsA.Rows(1).Font.Bold = True wsA.Range("B1").Value = "Dateiname" wsA.Range("C1").Value = "1.Fundzelle" For i = 1 To .FoundFiles.Count If Dir(.FoundFiles(i)) ThisWorkbook.Name Then Workbooks.Open .FoundFiles(i) Set wb = ActiveWorkbook Set ws = ActiveSheet Set erg = ws.Columns("D:D").Find(What:=wort, LookIn:=xlValues, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) If Not erg Is Nothing Then efz = wsA.Cells(Rows.Count, 1).End(xlUp).Row + 1 wsA.Cells(efz, 1).Value = .FoundFiles(i) ws.Hyperlinks.Add Anchor:=wsA.Cells(efz, 1), Address:=.FoundFiles(i) wsA.Cells(efz, 2).Value = Dir(.FoundFiles(i)) wsA.Cells(efz, 3).Value = erg.Address End If wb.Close False End If Next i End With wsA.Columns.AutoFit Application.DisplayAlerts = True Application.ScreenUpdating = True Application.AskToUpdateLinks = True End Sub

Beliebteste Forumthreads (12 Monate)

*.xls Dateien mit Makro nach Begriff durchsuchen

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

*.xls Dateien mit Makro nach Begriff durchsuchen

18 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

18
Beiträge zum Forumthread

Beiträge zu diesem Forumthread