VBA Tipp: Datei in allen Unterverzeichnissen suchen

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Ich möchte feststellen, ob und wie oft eine Datei in einem Verzeichnis und allen dazu gehörigen Unterverzeichnissen vorhanden ist.

  • Die Datei kann wahlweise mit bestimmter Dateierweiterung oder unabhängig von der Dateierweiterung gesucht werden.
  • Wahlweise können alle gefundenen Dateipfade oder nur der erste gefundene Dateipfad angezeigt werden.
  • Die gefundenen Dateipfade können wahlweise als String oder als Collection ausgegeben werden.

Lösung

Das geht mit der folgenden Funktion und Sub-Prozedur, die in einem globalen Modul gespeichert werden.

Public Function DateiSuchen(ByVal Startordner As String, _
                            ByVal DateiName As String, _
                            Optional ByVal Dateierweiterung As String = vbNullString, _
                            Optional ByVal NurErstenTrefferAusgeben As Boolean = False, _
                            Optional ByVal CollectionRückgabe As Boolean = False _
                            ) As Variant
 
 'Late Binding, kein Verweis auf "Microsoft Scripting Runtime" notwendig
 'Quelle: www.dbwiki.net oder www.dbwiki.de
 
 Dim FSO As Object             'Scripting.FileSystemObject
 Dim objOrdner As Object       'Scripting.Folder
 Dim Treffer As Collection
 Dim strTreffer As Variant
 Dim strPfade As String
 
 Set FSO = CreateObject("Scripting.FileSystemObject")
 Set objOrdner = FSO.GetFolder(Startordner)
 
 Set Treffer = New Collection
 DateiSuchenProzedur FSO, objOrdner, DateiName, Dateierweiterung, Treffer, NurErstenTrefferAusgeben
 
 Set FSO = Nothing
 Set objOrdner = Nothing
 
 If CollectionRückgabe Then
   Set DateiSuchen = Treffer
 Else
   If Treffer.Count = 0 Then
     DateiSuchen = vbNullString
   Else
     For Each strTreffer In Treffer
       strPfade = strPfade & vbNewLine & strTreffer
     Next
 
     DateiSuchen = Mid(strPfade, Len(vbNewLine) + 1)
   End If
 End If
 
End Function
 
Private Function DateiSuchenProzedur(ByVal FSO As Object, _
                                     ByVal SuchFolder As Object, _
                                     ByVal DateiName As String, _
                                     ByVal Dateierweiterung As String, _
                                     ByVal Treffer As Collection, _
                                     ByVal NurErstenTrefferAusgeben As Boolean _
                                     ) As Boolean
 
 Dim objUnterordner As Object  'Scripting.Folder
 Dim objDatei As Object        'Scripting.File
 Dim bolTreffer As Boolean
 
 'Alle Dateien des aktuellen Ordners auflisten
 For Each objDatei In SuchFolder.Files
 
   If Len(Dateierweiterung) = 0 Then
     bolTreffer = (FSO.GetBaseName(objDatei) = DateiName)
   Else
     bolTreffer = (FSO.GetFileName(objDatei) = DateiName & "." & Dateierweiterung)
   End If
 
   If bolTreffer Then
     Treffer.Add objDatei
 
     If NurErstenTrefferAusgeben Then
       DateiSuchenProzedur = True
       Exit Function
     End If
   End If
 
 Next objDatei
 
 For Each objUnterordner In SuchFolder.SubFolders
 
   'Alle Unterverzeichnisse verarbeiten (rekursiv)
   bolTreffer = bolTreffer Or DateiSuchenProzedur(FSO, objUnterordner, DateiName, _
                Dateierweiterung, Treffer, NurErstenTrefferAusgeben)
   If bolTreffer And NurErstenTrefferAusgeben Then
      DateiSuchenProzedur = True
      Exit Function
   End If
 
 Next objUnterordner
 
End Function

Aufruf

Die gefundenen Dateipfade werden im Direktenster aufgelistet.

 Dim strStartordner As String
 Dim strDateiname As String
 Dim strPfade As String        'für Beispiel 1-3
 Dim colPfade As Collection    'für Beispiel 4
 Dim varDatei As Variant       'für Beispiel 4
 
 strStartordner = CurrentProject.Path
 'Dateinamen ohne Dateierweiterung angeben
 strDateiname = "MeinDateiname"
 
 
 'Beispiel 1: Alle Dateinamen unabhängig von der Dateierweiterung suchen
 strPfade = DateiSuchen(strStartordner, strDateiname)
 
 'Beispiel 2: Alle Dateinamen mit bestimmter Dateierweiterung suchen
 strPfade = DateiSuchen(strStartordner, strDateiname, "doc")
 
 'Beispiel 3: Nur ersten Treffer anzeigen
 strPfade = DateiSuchen(strStartordner, strDateiname, , True)
 
 
 'Auswertung des Ergebnisses (Beispiel 1 bis 3)
 If strPfade = "" Then
   MsgBox "Datei nicht gefunden"
 Else
   Debug.Print strPfade
 End If
 
 '----------------------------------------------------------------
 'Beispiel 4: Alle Dateinamen suchen, Collection als Rückgabewert
 Set colPfade = DateiSuchen(strStartordner, strDateiname, , , True)
 
 'Auswertung des Ergebnisses (Beispiel 4)
 If colPfade.Count = 0 Then
   MsgBox "Datei nicht gefunden"
 Else
   For Each varDatei In colPfade
     Debug.Print varDatei
   Next
 End If