Excel - Beispiele: Dateien aus Verzeichnis und Unterverzeichnis einlesen

| home |

| impressum | feedback | home |

Dateien aus Verzeichnis und Unterverzeichnis einlesen
Versionen: Excel 97

Aus einem Verzeichnis inklusive aller Unterverzeichnisse sollen alle Dateien eingelesen werden.
Es soll eine Verzeichnisübersicht und eine Dateiliste erstellt werden

Die Verzeichnisübersicht soll die Verzeichnisnamen aller Verzeichnisse samt Unterverzeichnissen, die Anzahl der Unterverzeichnisse, die Anzahl der darin enthaltenen Dateien und deren gesamte Dateigröße enthalten.
Die Eintragung erfolgt in Tabelle1

A B C D
1 Pfad UnterVerz. Anz. Dateien Datgröße in Verz.
2 C:\Eigene Dateien 3 16 1,42789936
3 C:\Eigene Dateien\Download\ 2 1 0,25065136
4 C:\Eigene Dateien\Vorlagen\ 1 8 0,29530907
5 C:\Eigene Dateien\start\ 1 0 0
6 C:\Eigene Dateien\Download\ZIP\ 0 1 41,7140989
7 C:\Eigene Dateien\Download\McAfee\ 0 3 3,09511757
8 C:\Eigene Dateien\Vorlagen\Proof\ 0 21 5,99200249
9 C:\Eigene Dateien\start\00000\ 0 2 0,00076675

Die Dateiliste soll Dateinamen, Dateigröße und das Änderungsdatum enthalten. Zusätzlich soll ein Hyperlink zu den Dateien gesetzt werden.
Die Eintragung erfolgt in Tabelle2

A B C D
1
2 desktop.ini C:\Eigene Dateien\desktop.ini 125 13.07.00 22:22
3 URL.txt C:\Eigene Dateien\URL.txt 45 28.03.02 23:00
4 Pivot-Test.xls C:\Eigene Dateien\Pivot-Test.xls 29696 05.06.02 01:10
5 Titelleiste anpassen.xls C:\Eigene Dateien\Titelleiste anpassen.xls 20480 08.06.02 01:29
6 Urlaubsplaner V19M33BK.xls C:\Eigene Dateien\Urlaubsplaner V19M33BK.xls 120320 08.06.02 01:34
7 Urlaubsplaner V026VE5O.xls C:\Eigene Dateien\Urlaubsplaner V026VE5O.xls 27136 08.06.02 01:42
8 Urlaub_2002.zip C:\Eigene Dateien\Download\Urlaub_2002.zip 262827 08.06.02 00:41
9 Friedel - Fax.dot C:\Eigene Dateien\Vorlagen\Friedel - Fax.dot 48640 02.12.01 22:38
10 Petra - Fax.dot C:\Eigene Dateien\Vorlagen\Petra - Fax.dot 22528 02.12.01 22:41

Das Haupt - Verzeichnis wird mittels eines Verzeichnisbrowsers abgefragt und am Ende wird ein Meldung mit diversen Angaben angezeigt.

VBA-Entwicklungsumgebung öffnen und folgenden Code in ein Modul einfügen

Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As _
BROWSEINFO) As Long

Sub Verzeichnisse_auflisten()
Dim Pfad1, Name1, Anzahl, X, X0, X1, X2, Verz, Anzverz, Größe
Dim TB1, TB2 As Worksheet
Dim msg As String
Set TB1 = ThisWorkbook.Worksheets(1)
Set TB2 = ThisWorkbook.Worksheets(2)
Start = Now
TB1.[a:D] = ""
TB2.[a:D] = ""

' Pfad abfragen
msg = "Wählen Sie bitte einen Ordner aus:"
Pfad1 = getdirectory(msg)
If Pfad1 = "" Then Exit Sub
Name1 = Dir(Pfad1, vbDirectory) ' Ersten Eintrag abrufen.
TB1.[a2] = Pfad1
Anzahl = 2
TB1.[a1] = "Pfad"
TB1.[b1] = "UnterVerz."
TB1.[c1] = "Anz. Dateien"
TB1.[d1] = "Datgröße in Verz."
X0 = 2
X1 = 2
Do While TB1.Cells(Rows.Count, 1).End(xlUp).Row <> TB1.Cells(Rows.Count, 2).End(xlUp).Row
For X2 = X0 To X1

Pfad1 = TB1.Cells(X2, 1) ' Pfad setzen.
If Right(Pfad1, 1) <> "\" Then Pfad1 = Pfad1 & "\"
Name1 = Dir(Pfad1, vbDirectory) ' Ersten Eintrag abrufen.
Verz = 0
Do While Name1 <> "" ' Schleife beginnen.
' Aktuelles und übergeordnetes Verzeichnis ignorieren.
If Name1 <> "." And Name1 <> ".." Then
' Mit bit-weisem Vergleich sicherstellen, daß Name1 ein Verzeichnis ist.
If (GetAttr(Pfad1 & Name1) And vbDirectory) = vbDirectory Then
Anzahl = Anzahl + 1
TB1.Cells(Anzahl, 1) = Pfad1 & Name1 & "\"
Verz = Verz + 1
'Eintrag nur anzeigen, wenn es sich um ein Verzeichnis handelt.
End If
End If
Name1 = Dir
' Nächsten Eintrag abrufen.
Loop
TB1.Cells(X2, 2) = Verz
Next X2
X0 = X1 + 1
X1 = X2
Loop

'Dateien aus den Verzeichnissen auslesen
Anzverz = TB1.Cells(Rows.Count, 1).End(xlUp).Row
i = 1
ii = 0
For Verz = 2 To Anzverz
Anzahl = 0
Größe = 0
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(TB1.Cells(Verz, 1))
Set fc = f.Files

For Each f1 In fc
If i = 65536 Then
ii = ii + 1
ThisWorkbook.Worksheets.Add.Move After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
ThisWorkbook.Worksheets(ii + 2).Name = "Dateien " & ii + 1
Set TB2 = ThisWorkbook.Worksheets(ii + 2)
i = 1
End If
i = i + 1
Anzahl = Anzahl + 1
TB2.Cells(i, 1) = f1.Name
TB2.Cells(i, 2) = f & "\" & f1.Name
'Hyperlink auf die Datei einfügen
TB2.Hyperlinks.Add Anchor:=TB2.Cells(i, 2), Address:= _
f & "\" & f1.Name
TB2.Cells(i, 3) = FileLen(f1)
TB2.Cells(i, 4) = FileDateTime(f1)
Größe = Größe + FileLen(f1)
Next
TB1.Cells(Verz, 3) = Anzahl
TB1.Cells(Verz, 4) = Größe / 1024 / 1024
Next Verz
'MsgBox (ii * 65536) + i
ende = Now
MsgBox "Anzahl der Verzeichnisse: " & Verz & Chr(13) & _
"Anzahl der Dateien: " & (ii * 65536) + i & Chr(13) & _
Chr(13) & "Dauer: " & Format(ende - Start, "nn:ss")
End Sub

Function getdirectory(Optional msg) As String
Dim bInfo As BROWSEINFO
Dim Path As String
Dim r As Long, X As Long, pos As Integer
' Ausgangsordner = Desktop
bInfo.pidlRoot = 0&
' Dialogtitel
If IsMissing(msg) Then
bInfo.lpszTitle = "Wählen Sie bitte einen Ordner aus."
Else
bInfo.lpszTitle = msg
End If
' Rückgabe des Unterverzeichnisses
bInfo.ulFlags = &H1
' Dialog anzeigen
X = SHBrowseForFolder(bInfo)
' Ergebnis gliedern
Path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal Path)
If r Then
pos = InStr(Path, Chr$(0))
getdirectory = Left(Path, pos - 1)
Else
getdirectory = ""
End If
End Function

Makro "Verzeichnisse_auflisten" starten - viel Spaß

Dateien unter Vorgabe eines Filters aus Verzeichnis auslesen