… mir einige Exceldateien nach einem Wert durchsucht und die Dateinamen und vieleicht sogar den Pfad in denen diese Werte vorkommen auflistet. Die Dateien liegen auf einem Netzwerkordner und dessen Unterordnern. Ich habe schon ein paar Makros gesucht und gefunden, diese funktionieren leider nicht.
Danke
Hallo Glombus,
nachfolgend ein entsprechendes Makro (oder besser 2) zum Durchsuchen von Dateien.
Den Parameter für den Vergleich der Dateinamen muss du ggf. anpassen.
Gruß
Franz
'Code in einem allgemeinen Modul
Option Explicit
Public lngp\_File As Long, arrp\_Files() As String
'
Sub ListFilesInFolder(ByVal SourceFolderName As String, \_
Optional Datei As String = "\*.xls\*", \_
Optional IncludeSubfolders As Boolean = True)
'1.Parameter Ordner, wo soll gesucht werden?
'2.Parameter Datei,\* als Platzhalter verwenden, Optional leer ist alle
'3.Parameter mit Unterordner = True, Optional False ist ohne
'Erstellt gemäß Suchkriterien ein Array mit den Dateiifos
Dim FSO As Object, SourceFolder As Object, SubFolder As Object
Dim FileItem
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(SourceFolderName)
On Error GoTo Err\_Zugriff: 'sollte Ordner geschützt sein
For Each FileItem In SourceFolder.Files
If LCase(FileItem.Name) Like LCase(Datei) Then
lngp\_File = lngp\_File + 1
ReDim Preserve arrp\_Files(1 To 3, 1 To lngp\_File)
arrp\_Files(1, lngp\_File) = FileItem.Name 'Dateiname
arrp\_Files(2, lngp\_File) = FSO.GetParentFolderName(FileItem) 'Verzeichnis
arrp\_Files(3, lngp\_File) = FileItem 'Verzeichnis\Dateiname
End If
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, Datei, IncludeSubfolders
Next SubFolder
End If
Err\_Zugriff:
Set FileItem = Nothing: Set SourceFolder = Nothing: Set FSO = Nothing
End Sub
Sub Search\_in\_Files()
Dim varSuchen, rngFind As Range
Dim wbkQ As Workbook, wksQ As Worksheet
Dim wbkZ As Workbook, wksZ As Worksheet
Dim lngZeile As Long, lngFile As Long, StatusCalc As Long
Dim strVerz As String
On Error GoTo Fehler
varSuchen = InputBox("Suchbegriff", "Suche in Dateien")
If varSuchen = "" Then GoTo Fehler
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte zu durchsuchendes Verzeichnis auswhlen"
If .Show = -1 Then
strVerz = .SelectedItems(1)
'Dateiliste zurücksetzen
lngp\_File = 0
Erase arrp\_Files()
'Subroutine aufrufen zur Erstellung der Dateiliste
Call ListFilesInFolder(SourceFolderName:=strVerz, \_
Datei:="\*.xls\*", \_
IncludeSubfolders:=True)
If lngp\_File = 0 Then
MsgBox "Keine Dateien im gewählten Verzeichnis gefunden"
Else
With Application
StatusCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
'Dateiliste abarbeiten
For lngFile = 1 To lngp\_File
Application.StatusBar = "Datei " & lngFile & " von " \_
& lngp\_File & " wird bearbeitet: " & arrp\_Files(3, lngFile)
'Quelldatei öfnen
Set wbkQ = Workbooks.Open(Filename:=arrp\_Files(3, lngFile), ReadOnly:=True, \_
UpdateLinks:=False)
'Tabellenblätter in Quelldatei durchsuchen
For Each wksQ In wbkQ.Worksheets
'Suchbegriff suchen - Übereinstimmung mit ganzem Zellinhalt
Set rngFind = wksQ.Cells.Find(What:=varSuchen, LookIn:=xlValues, \_
lookat:=xlWhole, MatchCase:=False)
If Not rngFind Is Nothing Then
If wbkZ Is Nothing Then
'Datei mit Tabellenblatt für Ergebnisliste erstellen
Set wbkZ = Workbooks.Add(Template:=xlWBATWorksheet)
'Spaltentitel beschriften
lngZeile = 1
Set wksZ = wbkZ.Sheets(1)
wksZ.Cells(lngZeile, 1) = "Suchbegriff: " & varSuchen
wksZ.Cells(lngZeile, 2) = "Datum Zeit: " & Format(Now, "YYYY-MM-DD hh:mm:ss")
lngZeile = 2
wksZ.Cells(lngZeile, 1) = "Verzeichnis"
wksZ.Cells(lngZeile, 2) = "Dateiname"
Range("A3").Select
ActiveWindow.FreezePanes = True
End If
lngZeile = lngZeile + 1
wksZ.Cells(lngZeile, 1) = arrp\_Files(2, lngFile) 'Verzeichnis
wksZ.Cells(lngZeile, 2) = arrp\_Files(1, lngFile) 'Dateiname
Exit For
End If
Next wksQ
Set rngFind = Nothing
wbkQ.Close savechanges:=False
Next lngFile
If wbkZ Is Nothing Then
MsgBox "Suchbegriff in keiner der Dateien gefunden"
Else
wksZ.Columns.AutoFit
End If
End If
End If
End With
Fehler:
With Err
Select Case .Number
Case 0
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
With Application
.StatusBar = False
.Calculation = StatusCalc
.EnableEvents = True
.ScreenUpdating = True
End With
lngp\_File = 0
Erase arrp\_Files()
Set wbkQ = Nothing: Set wksQ = Nothing: Set wbkZ = Nothing: Set wksZ = Nothing
End Sub
Hallo Franz,
super vielen Dank! Das Makro funktionerte auf Anhieb. Leider läuft die Suche zu langsam. 91 Excel Dateien durchsucht das Makro im gegebenen Hardwaresetup (Computer/Netzwerk) in gefühlten fünf Minuten und lastet den Rechner komplett aus.
-Gibt es die Möglichkeit dem Makro zu sagen wenn du in einem Ordner fündig geworden bist, durchsuche diesen zu Ende und schreibe dann die Ergebnisse ohne die nächsten Ordner zu durchsuchen?
-Gibt es die Möglichkeit bei dem Fenster wo ich angebe welchen Ordner ich durchsuchen möchte, einen gewissen Ordner voreinzustellen, so das ich aber nach wie vor noch die Möglichkeit habe mich durch die Verzeichnisstruktur zu klicken?
Leider sind meine Kentnisse mit Makros stark beschränkt.
Vielen Dank
Hallo Glombus,
Leider
läuft die Suche zu langsam. 91 Excel Dateien durchsucht das
Makro im gegebenen Hardwaresetup (Computer/Netzwerk) in
gefühlten fünf Minuten und lastet den Rechner komplett aus.
naja, Netzwerk hin- oder her, letztlich werden dann doch die
Daten auf Festplatten stehen außer ihr hättet da andere Speichermedien.
Und Festplattenzugriffe sind halt langsam.
-Gibt es die Möglichkeit dem Makro zu sagen wenn du in einem
Ordner fündig geworden bist, durchsuche diesen zu Ende und
schreibe dann die Ergebnisse ohne die nächsten Ordner zu
durchsuchen?
? wie meinen? Du sagtest die Daten stehen in einem Ordner und
dessen Unterordnern!?
Entscheide dich bitte was du möchtest.
- ggf. würde auch beim ersten Treffer eine Option zum Beenden
der Suche unter Angabe des Pfades reichen.
Das weicht ja vom ersten Posting noch mehr ab. Du willst
schlichtweg wissen wo im ordner xyz und dessen Unterordnern
erstmalig eine Mappe auftaucht die ein bestimmtes Wort enthält?
Gruß
Reinhard
Hallo Glombus,
… Leider
läuft die Suche zu langsam. 91 Excel Dateien durchsucht das
Makro im gegebenen Hardwaresetup (Computer/Netzwerk) in
gefühlten fünf Minuten und lastet den Rechner komplett aus.
Wie lang sind denn die „gefühlten 5 Minuten“ in Realität?
5 * 60 Sekunden / 91 = 3 bis 4 Sekunden pro Datei für Suche nach allen Exceldateien in Haupt- und Unterverzeichnissen und Öffnen/Suchen/Schliessen für jede Datei.
Das ist je nach Größe der Dateien innerhalb eine Netzwerkes doch ein recht ordentlicher Wert.
-Gibt es die Möglichkeit dem Makro zu sagen wenn du in einem
Ordner fündig geworden bist, durchsuche diesen zu Ende und
schreibe dann die Ergebnisse ohne die nächsten Ordner zu
durchsuchen?
Ja, das ist kein Problem - 1. Fundstelle merken, dann Suchschleife verlassen, wenn sich der Ordner der Datei ändert
Allerdins bringt das bezüglich der Laufzeit wenig, wenn die Fundstelle sich in den zuletzt durchsuchten Ordnern befindet.
Du solltest dir also mal überlegen, ob man die Anzahl der zu öffnenden Dateien reduzieren lässt durch Anpassen des Dateisuchfilters oder auch des Datums der letzten Speicherung.
-Gibt es die Möglichkeit bei dem Fenster wo ich angebe welchen
Ordner ich durchsuchen möchte, einen gewissen Ordner
voreinzustellen…
Ja, man kann für den Auswahldialog ein Startverzeichnis vorgeben. Ich kenne aber nicht die exakte Schreibweise, die du bei einem Netzzwerk ggf. einhalten muss (Zeichne ein Makro auf mit Aktion „Datei öffnen“, dann sollte sollte da der Pfad entsprechend vorhanden sein.
Nachfolgend die angepasste Prozedur „Search_in_Files“
Gruß
Franz
Sub Search\_in\_Files()
Dim varSuchen, rngFind As Range
Dim wbkQ As Workbook, wksQ As Worksheet
Dim wbkZ As Workbook, wksZ As Worksheet
Dim lngZeile As Long, lngFile As Long, StatusCalc As Long
Dim strVerz As String
On Error GoTo Fehler
varSuchen = InputBox("Suchbegriff", "Suche in Dateien")
If varSuchen = "" Then GoTo Fehler
With Application.FileDialog(msoFileDialogFolderPicker)
strVerz = "C:\Users\Public" 'Start-Verzeichnis für die Verzeichnisauswahl - ANPASSEN!!
.InitialFileName = strVerz
.Title = "Bitte zu durchsuchendes Verzeichnis auswhlen"
If .Show = -1 Then
strVerz = .SelectedItems(1)
'Dateiliste zurücksetzen
lngp\_File = 0
Erase arrp\_Files()
'Subroutine aufrufen zur Erstellung der Dateiliste
Call ListFilesInFolder(SourceFolderName:=strVerz, \_
Datei:="\*.xls\*", \_
IncludeSubfolders:=True)
If lngp\_File = 0 Then
MsgBox "Keine Dateien im gewählten Verzeichnis gefunden"
Else
With Application
StatusCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
'Dateiliste abarbeiten
strVerz = ""
For lngFile = 1 To lngp\_File
Application.StatusBar = "Datei " & lngFile & " von " \_
& lngp\_File & " wird bearbeitet: " & arrp\_Files(3, lngFile)
If strVerz "" And strVerz arrp\_Files(2, lngFile) Then Exit For
'Quelldatei öffnen
Set wbkQ = Workbooks.Open(Filename:=arrp\_Files(3, lngFile), ReadOnly:=True, \_
UpdateLinks:=False)
'Tabellenblätter in Quelldatei durchsuchen
For Each wksQ In wbkQ.Worksheets
'Suchbegriff suchen - Übereinstimmung mit ganzem Zellinhalt
Set rngFind = wksQ.Cells.Find(What:=varSuchen, LookIn:=xlValues, \_
lookat:=xlWhole, MatchCase:=False)
If Not rngFind Is Nothing Then
If wbkZ Is Nothing Then
'Datei mit Tabellenblatt für Ergebnisliste erstellen
Set wbkZ = Workbooks.Add(Template:=xlWBATWorksheet)
'Spaltentitel beschriften
lngZeile = 1
Set wksZ = wbkZ.Sheets(1)
wksZ.Cells(lngZeile, 1) = "Suchbegriff: " & varSuchen
wksZ.Cells(lngZeile, 2) = "Datum Zeit: " & Format(Now, "YYYY-MM-DD hh:mm:ss")
lngZeile = 2
wksZ.Cells(lngZeile, 1) = "Verzeichnis"
wksZ.Cells(lngZeile, 2) = "Dateiname"
Range("A3").Select
ActiveWindow.FreezePanes = True
strVerz = arrp\_Files(2, lngFile) 'Verzeichnis mit Fundstelle merken
End If
lngZeile = lngZeile + 1
wksZ.Cells(lngZeile, 1) = arrp\_Files(2, lngFile) 'Verzeichnis
wksZ.Cells(lngZeile, 2) = arrp\_Files(1, lngFile) 'Dateiname
Exit For
End If
Next wksQ
Set rngFind = Nothing
wbkQ.Close savechanges:=False
Next lngFile
If wbkZ Is Nothing Then
MsgBox "Suchbegriff in keiner der Dateien gefunden"
Else
wksZ.Columns.AutoFit
End If
End If
End If
End With
Fehler:
With Err
Select Case .Number
Case 0
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
With Application
.StatusBar = False
.Calculation = StatusCalc
.EnableEvents = True
.ScreenUpdating = True
End With
lngp\_File = 0
Erase arrp\_Files()
Set wbkQ = Nothing: Set wksQ = Nothing: Set wbkZ = Nothing: Set wksZ = Nothing
End Sub
nachfolgend ein entsprechendes Makro (oder besser 2) zum
Durchsuchen von Dateien.
Hallo Franz
Ich habe Deine beiden Makros installiert. Es klappt bestens - allerdings mit einer Einschränkung:
Wenn die Zelle, die den gesuchten Begriff enthält nicht als „Standard“ formatiert ist, bleibt die Suche erfolglos. Ich verwende oft die Formatierung " 0 ; 0 ; @ "
Gibt es eine Lösung dafür - abgesehen von der einen, dass ich alle Excel-Datei auf Standard umformatiere?
Vielen Dank für Dein interessantes Makro und für Deine weiteren Bemühungen.
Viele Grüsse
Niclaus
Hallo Niclaus,
leider ist die Suche von speziell formatierten Zahlen und Datumswerten per Makro etwas problembehaftet.
Folgende halbwegs funktionierende Lösung hab ich jetzt gefunden.
Im Makro nicht in Werten sondern in Formeln suchen.
'Suchbegriff suchen - Übereinstimmung mit ganzem Zellinhalt
Set rngFind = wksQ.Cells.Find(What:=varSuchen, LookIn:=xlFormulas, _
lookat:=xlWhole, MatchCase:=False)
Bei der Eingabe des Suchbegriffs bei Zahlen-/Datumswerten die US-Formate für Dezimalzeichen (also Punkt) und Datum (M/T/JJJJ) verwenden.
ggf. kann man noch etwas mit den Wildcards ? und * tricksen
102.* findet z.B. alle Zahlen von 102,00 bis 102,99
10/*/2012 findet z.B. Datumswerte im Oktober 2012
*/1/2012 findet z.B. Datumswerte mit Tag 1 in beliebigen Monate in 2012
*/*/2013 findet Datumswerte in 2013
Gruß
Franz
Hallo Franz,
auf einem Rechner mit etwas mehr Rechenleistung bin ich jetzt bei unter 1Sek pro zu durchsuchender Excel Datei.
Eine letzte Frage habe ich jedoch noch. Gibt es die Möglichkeit Dateien von der Suche auszuschließen? Diese stehen bevorzugt in einer .txt Datei.
Vielen vielen Dank
Hallo Glombus,
natürlich kann man Dateien ausschliessen,
Allerdings bei meiner Lösung nicht von der Suche (Diese sucht erst einmal alle Excel-Dateien gemäß eingestelltem Dateifilter in den Verzeichnissen), sondern vom Öffnen.
Mein bevorzugter Ort für die Liste der auszuschliessenden Dateien wäre ein Tabellenblatt in der Exceldatei in der das Makro gespeichert ist. Eine Textdatei ginge aber auch. Ist halt mehr Programmieraufwand.
Dabei sind zu berücksichtigen:
Wie stehen die Dateinamen in der Datei?
Nur Dateiname oder Pfad\Dateiname?
Was soll beim Vergleich übereinstimmen?
Nur Dateiname oder ggf. Pfad\Dateiname?
Wie stehen die Dateinamen in der Text-Datei?
Je Datei eine Zeile?
Alle Namen in einer Zeile getrennt durch ein Trennzeichen?
Wenn Trennzeichen. Welches?
Gruß
Franz
Hallo Franz,
bitte entschuldige meine späte Antwort. Da ich meine auszuschließenden Dateien via dir in cmd aus einer aufgearbeitetenden Liste ziehen würde, wäre es //pfad/datei.xls*. Diese lassen sich problemlos via copy & paste in ein Tabellenblatt der Datei einfügen in der sich das Makro befindet. Dadurch das eindeutige Dateinamen verfügbar sind, wäre natürlich auch der Vergleich zu jenen möglich. Ergo //Pfad/dateiname.xls* oder aber dateiname.xls* in „tabelle2“ der Datei in der sich das Makro befindet, bzw. wie es dir leichter fällt.
Vielen Dank noch mal
Hallo Glombus,
urlaubsbedingt meine Antwort auch etwas später.
Hier die Hauptprozedur angepasst, so dass die gefundenen Dateien vor dem Öffnen mit der Ausschlussliste in einem Tabellenblatt abgeglichen werden. Den Namen „Dateiliste“ ggf. anpassen.
Verglichen wird der Dateiname ohne Verzeichnis, kann aber einfach auf Dateiname inkl. Verzeichnis umgestellt werden.
Gruß
Franz
Sub Search\_in\_Files()
Dim varSuchen, rngFind As Range
Dim wbkQ As Workbook, wksQ As Worksheet
Dim wbkZ As Workbook, wksZ As Worksheet, wksPruef As Worksheet
Dim lngZeile As Long, lngFile As Long, StatusCalc As Long, varFound As Variant
Dim strVerz As String
On Error GoTo Fehler
varSuchen = InputBox("Suchbegriff", "Suche in Dateien")
If varSuchen = "" Then GoTo Fehler
With Application.FileDialog(msoFileDialogFolderPicker)
strVerz = "C:\Users\Public\Test" 'Start-Verzeichnis für die Verzeichnisauswahl - ANPASSEN!!
.InitialFileName = strVerz
.Title = "Bitte zu durchsuchendes Verzeichnis auswählen"
If .Show = -1 Then
strVerz = .SelectedItems(1)
'Dateiliste zurücksetzen
lngp\_File = 0
Erase arrp\_Files()
'Subroutine aufrufen zur Erstellung der Dateiliste
Call ListFilesInFolder(SourceFolderName:=strVerz, \_
Datei:="\*.xls\*", \_
IncludeSubfolders:=True)
If lngp\_File = 0 Then
MsgBox "Keine Dateien im gewählten Verzeichnis gefunden"
Else
With Application
StatusCalc = .Calculation
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
'Dateiliste abarbeiten
strVerz = ""
Set wksPruef = ActiveWorkbook.Worksheets("Dateiliste") 'Blatt mit Ausschlussliste
For lngFile = 1 To lngp\_File
Application.StatusBar = "Datei " & lngFile & " von " \_
& lngp\_File & " wird bearbeitet: " & arrp\_Files(3, lngFile)
' If strVerz "" And strVerz arrp\_Files(2, lngFile) Then Exit For 'aktivieren - wenn \_
weiterhin nach der 1. Fundstelle abgebrochen werden soll
'Datei mit Liste nicht zu prüfender Dateien vergleichen - nur Dateiname ohne Pfad
varFound = Application.Match(arrp\_Files(1, lngFile), wksPruef.Columns(1), 0)
If IsNumeric(varFound) Then GoTo Next\_File
'Quelldatei öffnen
Set wbkQ = Workbooks.Open(Filename:=arrp\_Files(3, lngFile), ReadOnly:=True, \_
UpdateLinks:=False)
'Tabellenblätter in Quelldatei durchsuchen
For Each wksQ In wbkQ.Worksheets
'Suchbegriff suchen - Übereinstimmung mit ganzem Zellinhalt
Set rngFind = wksQ.Cells.Find(What:=varSuchen, LookIn:=xlFormulas, \_
lookat:=xlWhole, MatchCase:=False)
' Set rngFind = wksQ.Cells.Find(What:=varSuchen, LookIn:=xlValues, \_
lookat:=xlWhole, MatchCase:=False)
If Not rngFind Is Nothing Then
If wbkZ Is Nothing Then
'Datei mit Tabellenblatt für Ergebnisliste erstellen
Set wbkZ = Workbooks.Add(Template:=xlWBATWorksheet)
'Spaltentitel beschriften
lngZeile = 1
Set wksZ = wbkZ.Sheets(1)
wksZ.Cells(lngZeile, 1) = "Suchbegriff: " & varSuchen
wksZ.Cells(lngZeile, 2) = "Datum Zeit: " & Format(Now, "YYYY-MM-DD hh:mm:ss")
lngZeile = 2
wksZ.Cells(lngZeile, 1) = "Verzeichnis"
wksZ.Cells(lngZeile, 2) = "Dateiname"
Range("A3").Select
ActiveWindow.FreezePanes = True
strVerz = arrp\_Files(2, lngFile) 'Verzeichnis mit Fundstelle merken
End If
lngZeile = lngZeile + 1
wksZ.Cells(lngZeile, 1) = arrp\_Files(2, lngFile) 'Verzeichnis
wksZ.Cells(lngZeile, 2) = arrp\_Files(1, lngFile) 'Dateiname
Exit For
End If
Next wksQ
Set rngFind = Nothing
wbkQ.Close savechanges:=False
Next\_File:
Next lngFile
If wbkZ Is Nothing Then
MsgBox "Suchbegriff in keiner der Dateien gefunden"
Else
wksZ.Columns.AutoFit
End If
End If
End If
End With
Fehler:
With Err
Select Case .Number
Case 0
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
With Application
.StatusBar = False
.Calculation = StatusCalc
.EnableEvents = True
.ScreenUpdating = True
End With
lngp\_File = 0
Erase arrp\_Files()
Set wbkQ = Nothing: Set wksQ = Nothing: Set wbkZ = Nothing
Set wksZ = Nothing: Set wksPruef = Nothing
End Sub