VBA stellt einige Funktionen bereit um auf das Dateisystem zugreifen zu können, z. B. um die Existenz von Verzeichnissen abzufragen, Dateien zu löschen oder Dateien zu kopieren. Als Alternative kann das FileSystem-Objekt genutzt werden.
Achtung:
Beim Testen der Beispiele bitte unbedingt darauf achten, dass nicht versehentlich wichtige Ordner gelöscht werden. Das gilt insbesondere für die Funktionen „Kill“ und „RmDir“. Mit VBA gelöschte Dateien oder Ordner können nicht ohne weiteres wieder hergestellt werden. Es empfiehlt sich, eine Testumgebung in einem Ordner einzurichten, in dem nichts passieren kann.
Dir VBA Funktion CurDir liefert oft nicht das Ergebnis, das man sich wünscht. Angenommen die Excel Datei, die den VBA Code enthält, befindet sich im Verzeichnis
E:\Dokumente\Excel Neu\vba\_Blog\Beispiele
Dann liefert CurDir folgende Ergebnisse („username“ steht für den von Windows verwendeten User Namen):
CurDir()
Ergebnis: "C:\Users\username\Documents"
' Es handelt sich um das Verzeichnis, das in Excel unter "Optionen" -> "Speicher" -> "Lokaler Speicherort für Datei" steht.
CurDir("E")
Ergebnis: "E:\"Benötigt man den Pfad, in dem sich die Excel Datei befindet, könnte man stattdessen folgende Anweisungen verwenden:
ThisWorkbook.Path ' liefert den Pfad für die Excel Datei, die den VBA Code befindet.
ActiveWorkbook.Path ' liefert den Pfad für die Excel Datei, die gerade aktiv ist.Dir
Die Synthax für den Dir Befehl ist wie folgt
Dir [(Pfadname, [Attribute])]
Die Argument sind
Es gibt folgende Attributwerte:
Die Attributwerte können auch addiert werden, z. B.
- vbNormal + vbReadOnly + vbHidden + vbSystem + vbDirectory = 23
- vbNormal + vbReadOnly + vbHidden + vbSystem + vbVolume + vbDirectory = 31
Wichtige Punkte zur VBA DIR-Funktion:
- Beide Argumente in der DIR-Funktion sind optional.
- Sie können Platzhalterzeichen wie: „?“ oder „*“ verwenden, um mehrere Dateien anzugeben:
„*“ ist ein Platzhalter für eine Zeichenfolge beliebiger Länge (einschließlich der Länge Null)
„?“ ist ein Platzhalter für ein einzelnes Zeichen. - Bei ersten Aufruf der DIR-Funktion muss der „Pfadname“ angegeben werden. Es wird der Name einer Datei im Verzeichnis zurückgegeben. Nachfolgende Aufrufe der DIR-Funktion können ohne Argumente erfolgen, um den nächsten Dateinamen zu erhalten.
Beispiele:
Beispiel:
Die Namen aller Dateien im vorgegebenen Verzeichnis werden im Direktfenster ausgeben.
Anmerkung: Die Namen der Dateien im Direktfenster können markiert und kopiert werden. Anschließend kann man sie in ein Excel Tabellenblatt einfügen.
Sub AlleDateienDurchlaufen()
' Alle Dateien in einem Verzeichnis mit VBA durchlaufen
Dim StrFile As String
' Das letze Zeichen im Pfadnamen muss ein backslash "\" sein
StrFile = Dir("E:\Dokumente\Excel Neu\vba\_Blog\Beispiele\")
Do While Len(StrFile) > 0
Debug.Print StrFile
StrFile = Dir
Loop
End SubDie Prozedur lässt sich so umschreiben, dass die gefundenen Dateien und das Verzeichnis in ein Excel Tabellenblatt geschrieben werden:
Sub AlleDateienDurchlaufen_2()
' Alle Dateien in einem Verzeichnis mit VBA durchlaufen
' https://stackoverflow.com/questions/10380312/loop-through-files-in-a-folder-using-vba
Dim strDatei As String, iZeile As Integer, ws As Worksheet, strPfad As String
Set ws = Worksheets("Tabelle2")
' Das letze Zeichen im Pfadnamen muss ein backslash "\" sein
strPfad = "E:\Dokumente\Excel Neu\vba\_Blog\Beispiele\"
strDatei = Dir(strPfad)
iZeile = 2
Do While Len(strDatei) > 0
ws.Cells(iZeile, 1).value = strDatei
ws.Cells(iZeile, 2).value = strPfad
iZeile = iZeile + 1
strDatei = Dir
Loop
set ws = Nothing
End SubBeispiel: alle Dateien in einem Verzeichnis sowie in allen Unterverzeichnissen im Direktfenster ausgeben.
Hier wird die Sub Prozedur „Recursive“ verwendet, um das Verzeichnis sowie alle Unterverzeichnisse rekursiv zu durchsuchen. Die Prozedur lässt sich mit wenig Aufwand so ändern, dass die gefundenen Verzeichnisse und Dateien in ein Excel Tabellenblatt geschrieben werden.
Sub DateienInVerzeichnisUndUnterverzeichnissen()
Dim strDateiname As String ' Dateiname, nach dem Sie suchen.
Dim strVerzeichnis As String ' Der vollstaendige Pfad zu dem Ordner, in dem Sie mit der Suche beginnen möchten.
' Die Funktion durchsucht auch alle Unterordner dieses Ordners.
Dim varItem As Variant, dict As Object, varFeld As Variant
'
Set dict = CreateObject("Scripting.Dictionary")
'
strVerzeichnis = "E:\Dokumente\Excel Neu\vba\_Command File\"
strDateiname = "*.*"
'
Call Recursive(strDateiname, strVerzeichnis, dict)
'
' Ergebnis im Direktfenster ausgeben
For Each varItem In dict
Debug.Print varItem, dict(varItem)
Next
'
Set dict = Nothing
End Sub
Sub Recursive(FileName As String, FolderPath As String, dict As Object)
Dim value As String, Folders() As String
Dim Folder As Variant, a As Long
ReDim Folders(0)
'
If Right(FolderPath, 2) = "\\" Then Exit Sub
'
value = Dir(FolderPath & FileName, &H1F) ' Hex &H1F = Decimal 31
'
Do Until value = ""
If value <> "." And value <> ".." Then
If GetAttr(FolderPath & value) = 16 Then
' Directory or folder
Folders(UBound(Folders)) = value
ReDim Preserve Folders(UBound(Folders) + 1)
Else
If dict.exists(value) = False Then dict.Add FolderPath & value, value
End If
End If
value = Dir
Loop
'
For Each Folder In Folders
Call Recursive(FileName, FolderPath & Folder & "\", dict)
Next Folder
'
End SubBeispie: überprüfen, ob eine Datei existiert:
Sub Test_CheckDatei()
Dim strPath As String
strPath = "E:\Dokumente\Excel Neu\vba\_Blog\Beispiele\Beispielcode_2022_08_11.xlsm"
Debug.Print CheckDatei(strPath)
End Sub
Function CheckDatei(strFullname As String) As Boolean
CheckDatei = CBool(Dir(strFullname, vbDirectory) <> "")
End FunctionAb und zu kann es notwendig sein, den Pfad oder den Dateinamen aus dem vollständigen Dateinamen zu extrahieren. Dies ist mit den beiden Funktionen „DateiName“ und „Pfad“ möglich.
Sub test_DateiName()
Dim strPfadUndDatei As String
strPfadUndDatei = "E:\Dokumente\Excel Neu\vba\_Blog\Beispiele\Dir_2022_08_28.xlsm"
Debug.Print DateiName(strPfadUndDatei)
End Sub
Function DateiName(strPfadUndDatei As String) As String
DateiName = Mid(strPfadUndDatei, InStrRev(strPfadUndDatei, "\") + 1)
End Function
' ***********************
Sub test_Pfad()
Dim strPfadUndDatei As String
strPfadUndDatei = "E:\Dokumente\Excel Neu\vba\_Blog\Beispiele\Dir_2022_08_28.xlsm"
Debug.Print Pfad(strPfadUndDatei)
End Sub
Function Pfad(strPfadUndDatei As String) As String
Pfad = Left(strPfadUndDatei, InStrRev(strPfadUndDatei, "\"))
End FunctionFileSystemObject
Falls ein erweiterter Zugriff auf Laufwerke, Verzeichnisse und Dateien notwendig sein sollte, empfiehlt sich das modernere FileSystemObject zu verwenden. Man nutzt hierfür die Microsoft Scripting Runtime-Objektbibliothek. Diese kann wie folgt verfügbar gemacht werden:
Early Binding:
Über das Setzen eines Verweises auf die Bibliothek „Microsoft VBScript Regular Expressions 5.5“. Hierzu im Visual Basic Editor auf Extras > Verweise > Microsoft Scripting Runtime gehen.
Durch Klicken auf „Verweise“ erhält man folgendes Menü, in dem man das Häkchen bei „Microsoft Scripting Runtime“ setzt.
Ist der Verweis gesetzt kann das VBA FielSystemObject wie folgt verwendet werden:
Dim fso As Object Deklaration des Objekts
Set fso = New FileSystemObject Zuweisen des FileSystemObjects
Late Binding:
Über die Anweisung CreateObject(„Scripting.FileSystemObject“), z. B.
Dim fso as Objekt ' Deklaration des Objektes
Set fso = CreateObject("Scripting.FileSystemObject") Beispiel:
Informationen zu allen vorhandenen Laufwerken werden im Direktfenster ausgegeben.
Public Sub ZeigeLaufwerke()
Dim fso As Object, d As Variant, ds As Object
'
Set fso = CreateObject("Scripting.FileSystemObject")
Set ds = fso.Drives
'
Debug.Print "Laufwerke:"
For Each d In ds
Debug.Print d.DriveLetter, 'Laufwerksbuchstabe
If d.IsReady Then
If d.DriveType = 3 Then 'Laufwerkstyp
' DriveType = 3 Netzlaufwerke. Dazu gehören Laufwerke, die an
' einem beliebigen Ort in einem Netzwerk freigegeben sind.
Debug.Print d.ShareName,
Else
Debug.Print d.VolumeName,
End If
Debug.Print d.FreeSpace & " von " & d.TotalSize & " frei" 'Speicherplatz
Else
Debug.Print "Keine CD eingelegt"
End If
Next
'
Set fso = Nothing
End Sub
Sub DateinamenErhalten()
Dim MyFSO As Object, myFile As Object, MyFolder As Object
Dim strPath As String
'
strPath = "E:\Dokumente\Excel Neu\vba\_Command File\2020_06_09"
'
Set MyFSO = CreateObject("Scripting.FileSystemObject")
If MyFSO.FolderExists(strPath) = True Then
Set MyFolder = MyFSO.GetFolder(strPath)
'
For Each myFile In MyFolder.Files
Debug.Print myFile.Name
Next myFile
End If
'
Set MyFSO = Nothing
End SubBeispiel:
Die Namen der Dateien im vorgegebenen Verzeichnis werden im Direktfenster ausgegeben.
Anmerkung: Die Namen der Dateien im Direktfenster können markiert und kopiert werden. Anschließend kann man sie in ein Excel Tabellenblatt einfügen.
Beispiel:
Bie Namen aller Dateien im angegebenen Verzeichnis sowie in allen Unterverzeichnissen werden ausgegeben. Das Hauptprogrann ist die Sub Tes_RecursiveFSO().
Sub RecurseFSO(dict As Object, FSO As Object, sPath As String)
Dim MyFolder As Object, mySubFolder As Object, myFile As Object
'
If FSO.FolderExists(sPath) = True Then
Set MyFolder = FSO.GetFolder(sPath)
'
For Each myFile In MyFolder.Files
If dict.exists(MyFolder.Path & "\" & myFile.Name) = False Then
dict.Add MyFolder.Path & "\" & myFile.Name, myFile.Name
End If
Next
'
For Each mySubFolder In MyFolder.SubFolders
Call RecurseFSO(dict, FSO, mySubFolder.Path)
Next
End If
End Sub
Sub Test_RecurseFSO()
Dim strPath As String
Dim FSO As Object, dict As Object, varItem As Variant
'
strPath = "E:\Dokumente\Excel Neu\vba\_Command File\"
'
Set dict = CreateObject("Scripting.Dictionary")
Set FSO = CreateObject("Scripting.FileSystemObject")
'
Call RecurseFSO(dict, FSO, strPath)
For Each varItem In dict
Debug.Print varItem
Next
'
Set dict = Nothing
Set FSO = Nothing
End Sub