Start | Über uns | Aktuelles | Datenschutz | Impressum | Kontakt | Sitemap
Klicktipps.de

Klicktipps®

Suche in www.klicktipps.de

Antworten auf Fragen, die das Leben stellt.

Excel-Tipps: Excel VBA: Ersatz für Application.Filesearch

Die Funktion Application.FileSearch gibt es ab Excel 2007 bzw. Access 2007 nicht mehr im Visual Basic (VBA). Mit dieser Funktion kann man die in Ordnern und Unterordnern vorhandenen Dateien ermitteln. Sie wurde seltsamerweise nicht nach Office 2007 oder Office 2010 übernommen. Ein Update, Ersatz oder Replacement hierzu ist bisher nicht erhältlich.
Das Vorgehen von Microsoft hierbei ist völlig unverständlich. Weltweit werden dadurch hunderte oder tausende von VBA-Anwendungen beim Übergang von Office 2003 auf Office 2007 stehen bleiben (Meldung: Run-Time Error 5111).

In dieser Seite ist beschrieben, wie man die Funktion Application.FileSearch durch andere VBA-Möglichkeiten ersetzen kann. Die Beispiele wurden in Excel 2003, 2007 und 2010 und auch unter den entsprechenden Word-Versionen getestet. Sie laufen so oder sehr ähnlich sicherlich auch in den entsprechenden Access-Versionen.

Weitere Tipps, Fragen, Bücher und Informationen Zu Excel finden Sie in meiner Excel-Seite unter:


VBA: Ersatz für Application.FileSearch

Was kann man tun, wenn man feststellt, dass Excel-Anwendungen ausfallen, weil der Befehl Application.FileSearch fehlt?

Zunächst sollte man sich fragen, ob die Namen der gesuchten Dateien und ihre Dateinamen schon vor der Suche bekannt sind oder generiert werden können. Diese Dateien könnte man z. B. mit dem Befehl Open direkt ansprechen, und Application.FileSearch würde gar nicht wirklich benötigt.
Zusätzlich sollte man klären, ob nur jeweils ein Verzeichnis/Ordner abgearbeitet werden muss, oder ob auch seine Unterverzeichnisse/Unterordner systematisch untersucht werden müssen.

Wenn das Durcharbeiten eines Verzeichnisses und aller seiner Dateien nötig ist, kann zumindest für das "Lesen ohne Unterordner" folgende Lösung helfen:

Option Explicit Sub Test() 'Ersatz für Application.FileSearch entwickeln und testen Dim Pfad As String 'Startpfad Dim Daten As New Collection 'gesammelte Ergebinsse Dim Eintrag Pfad = ThisWorkbook.Path 'wenn dieses Programm unter Excel läuft 'Pfad = ActiveDocument.Path 'falls es unter Word laufen soll 'Mehrere Möglichkeiten für die Suche: Call FileList(Daten, Pfad) 'Alles im aktuellen Ordner 'Call FileList(Daten, Pfad, "*.xl*") 'Exceldateien im aktuellen Ordner 'Call FileList(Daten, "C:\Xxxxx\yyyy") 'Inhalt von Ordner C:\Xxxxx\yyyy 'Call FileList(Daten, Pfad & "\..", "*.xl*") 'Excel im übergeordneten Ordner If Daten.Count = 0 Then MsgBox ("In Ordner " & Pfad & " Nichts gefunden.") Exit Sub End If For Each Eintrag In Daten 'Testausgabe im Direktbereich (Funktionen: siehe voriger Abschnitt) Debug.Print Pfadname_von(Eintrag) & " " & Dateiname_von(Eintrag) 'hier könnten dann Ihre weiteren Befehle stehen '... '... Next Eintrag End Sub Sub FileList(Daten As Collection, Pfad As String, _ Optional Filter As String = "", _ Optional SubDIR As Boolean = False) 'Inhalt eines Ordners ermitteln 'Lösung mit dem Befehl Dir() ohne Rekursion ' 'Optionaler Parameter Filter: z. B. "*.xl*" für Excel-Dateien ' oder "*.doc*" für Word-Dateien ' ohne diesen Parameter werden auch Ordnernamen mit ausgegeben ' 'Optionaler Parameter SubDIR: True : mit Suche von Unterordnern ' (noch nicht realisiert) ' False : keine Suche in Unterordnern Dim OneItem As String Filter = Trim(Filter) If Right$(Pfad, 1) <> "\" Then Pfad = Pfad & "\" 'ersten Eintrag im Ordner lesen If SubDIR Or (SubDIR = False And Filter = "") Then OneItem = Dir(Pfad & Filter, vbDirectory) 'Ausgabe mit Ordnernamen Else OneItem = Dir(Pfad & Filter) 'Ausgabe ohne Ordnernamen End If 'Eintrag verarbeiten u. nächsten Eintrag lesen While OneItem <> "" If OneItem <> "." And OneItem <> ".." Then 'Ergebnisse sammeln: Pfad & Dateiname Daten.Add (Pfad & OneItem) End If OneItem = Dir 'nächsten Eintrag im Ordner lesen Wend End Sub


Vielleicht möchten Sie ja selbst mal dazu eine Lösung zu "Dir() mit Rekursion" für das Lesen von Unterordnern entwickeln(?).

Hier folgt eine andere Lösung mit rekursivem Lesen. Sie verwendet "Scripting.FileSystemObject" und wertet auch die Unterordner aus:

Option Explicit Sub Test2() 'Ersatz für Application.FileSearch entwickeln und testen 'mit Rekursion zum Lesen der Unterordner Dim Startpfad As String Dim Daten As New Collection 'gesammelte Ergebinsse Dim Eintrag Dim ii As Long Startpfad = ThisWorkbook.Path 'wenn dieses Programm in Excel läuft 'Startpfad = ActiveDocument.Path 'falls es unter Word laufen soll 'alle Dateien sammeln Call ListFilesInFolder(Daten, Startpfad, True) 'nichts gefunden If Daten.Count = 0 Then MsgBox ("In Ordner " & Startpfad & " Nichts gefunden.") Exit Sub End If 'Ergebnis filtern, z. B. nur Excel-Dateien zulassen For ii = Daten.Count To 1 Step -1 If InStr(Dateiendung_von(Daten(ii)), ".xl") <> 1 Then Daten.Remove ii End If Next ii 'Dateinamen auflisten (oder benutzen) For Each Eintrag In Daten 'Testausgabe im Direktbereich (Funktionen: siehe voriger Abschnitt) Debug.Print Pfadname_von(Eintrag) & " " & Dateiname_von(Eintrag) 'hier könnten dann Ihre weiteren Befehle stehen '... '... '... Next Eintrag End Sub Sub ListFilesInFolder(Daten As Collection, SourceFolderName As String, _ IncludeSubfolders As Boolean) 'alle Dateien in SourceFolder auflisten 'Beispiel: ListFilesInFolder "C:\FolderName\", True Dim FSO Set FSO = CreateObject("Scripting.FileSystemObject") Dim SourceFolder, SubFolder, FileItem Set SourceFolder = FSO.GetFolder(SourceFolderName) For Each FileItem In SourceFolder.Files Daten.Add FileItem.Path Next FileItem If IncludeSubfolders Then For Each SubFolder In SourceFolder.SubFolders ListFilesInFolder Daten, SubFolder.Path, True Next SubFolder End If Set FileItem = Nothing Set SourceFolder = Nothing Set FSO = Nothing End Sub


Die in diesem Beispiel verwendeten Funktionen zum Auftrennnen von Pfad, Dateiname und Dateiendung sind so definiert:

Function Pfadname_von(aa) As String 'Pfadname abtrennen Pfadname_von = Left(aa, InStrRev(aa, "\") - 1) End Function Function Dateiname_von(aa) As String 'Dateiname abtrennen Dateiname_von = Mid(aa, InStrRev(aa, "\") + 1) End Function Function Dateiendung_von(aa) As String 'Dateiendung (mit Punkt) abtrennen If InStrRev(aa, ".") = 0 Then Dateiendung_von = "" Exit Function End If Dateiendung_von = Mid(aa, InStrRev(aa, ".")) End Function

zum Seitenanfang


VBA: Die aktuelle Excel- bzw. Office-Version mit Application.Version abfragen

Die obigen Programme lösen zwar Ihre Probleme, aber gelegentlich wollen Sie vielleicht trotzdem abfragen, in welcher Verson Ihr VBA-Programm gerade läuft. Das kann mit Application.Version abgefragt und mit Case ausgewertet werden; Beispiel:

Sub Version_erkennen() 'Office-Version ermitteln Dim Ausgabe As String Select Case Int(Val(Application.Version)) Case 8 Ausgabe = "Excel 97" Case 9 Ausgabe = "Excel 2000" Case 10 Ausgabe = "Excel 2002/XP" Case 11 Ausgabe = "Excel 2003" Case 12 Ausgabe = "Excel 2007" Case 14 Ausgabe = "Excel 2010" Case Is > 14 Ausgabe = "Excel Version > 2010" Case Else MsgBox "Unbekannte Version von Excel" Exit Sub End Select MsgBox Ausgabe, vbInformation 'Hinweis: Es gibt hierfür auch eine Formel, die man 'in Tabellenzellen schreiben kann: =INFO("Version") End Sub

zum Seitenanfang

VBA-Bücher

Und noch ein paar Bücher zur Einführung in die VBA-Programmierung:



VBA-Links

zum Seitenanfang





© Klicktipps® (www.Klicktipps.de):
Dieser Ausdruck ist nur für den eigenen Gebrauch freigegeben.
Eine Vervielfältigung ist nicht gestattet und auch wenig sinnvoll,
da sich der Inhalt durch Aktualisierungen häufig ändert.