Office: Ordner und Dateien per Makro in Excel auflisten

cms · 24. Mai 2006

Hallo Zusammen!

Für eine ziemlich aufwändige Informationsfindung in unzähligen Dateien versuche ich mich aktuell an einem Makro, welches mir automatisch sämtliche Unterordner mit allen enthaltenen Dateien auflistet.

Das Ganze sollte dann ungefähr so aussehen:
Unterordner 1 Datei 1
Unterordner 1 Datei 2
Unterordner 1 Datei 3
Unterordner 2 Datei 1
Unterordner 3 Datei 1
Unterordner 3 Datei 2
usw.

Hab versucht mich da mit der VBA-Hilfe durchzuarbeiten aber das hat bisher leider keine vielversprechenden Ergebnisse gebracht!

:)

MRR · 25. Mai 2006

Hallo cms,
dazu gibt es schon viele Beiträge hier im Forum - SUCHFUNKTION!
Z.B. Diesen hier

cms · 25. Mai 2006

Hi MRR!

Vielen Dank für den Tipp!
Werd beim nächsten Mal genauer schauen obs schon einen Thread zum Thema gibt.

cms · 26. Mai 2006

Hab mich gestern noch intensiv durch die bisherigen Threads und die Links zu dem Thema durchgearbeitet, aber die Samples sind für mich als StandardVBAuser viel zu kompliziert. Ich habs nicht geschafft einen der Codes in mein Workbook zu implementieren.

Für meine Zwecke reicht einfach eine Liste der Ordner mit den enthaltenen Dateien im aktuellen Verzeichnis. Hab selbst versucht es mit der VBA Hilfe zu lösen, habs aber bisher nicht geschafft. Vielleicht hat jemand einen Tipp für mich (Befehl oder so).

User · 26. Mai 2006

Hi Du,

vielleicht hilft dir dieser Code weiter

Code:

Sub Dateiname_Pfad_auslesen()
'**************************************************
'* 07.10.04, 31.07.05; 02.08.05 *
'* erstellt von Ramses Rainer *
'* Anpassungen von Hajo *
'* http://home.media-n.de/ziplies/ *
'* *
'**************************************************
Dim Dateiform As String
Dim InI As Long, TotFiles As Long
Dim Suchpfad As String
Dim OldStatus As Variant
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad definieren", Application.DefaultFilePath)
If Suchpfad = "" Then Exit Sub
Dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.xls")
If Dateiform = "" Then Exit Sub
Application.ScreenUpdating = True
OldStatus = Application.StatusBar
' neue Tabelle anlegen
Sheets.Add After:=Worksheets(Worksheets.Count)
With Application.FileSearch
.LookIn = Suchpfad ' Suchverzeichnis
.SearchSubFolders = True ' suchen auch in Unterverzeichnis
.Filename = Dateiform
If .Execute() > 0 Then
TotFiles = .FoundFiles.Count
Application.StatusBar = "Total " & TotFiles & " gefunden"
For InI = 1 To .FoundFiles.Count
Application.StatusBar = "Datei: " & InI & " von " & TotFiles
' Dateiname in Zelle schreiben
Cells(InI, 1) = .FoundFiles(InI) ' Dateiname mit Pfad
' ergänzt Dateigröße und Dateidatum
Cells(InI, 2) = FileLen(.FoundFiles(InI)) ' Dateigröße
Cells(InI, 3) = FileDateTime(.FoundFiles(InI)) ' Dateidatum
Next InI
End If
End With
Application.StatusBar = OldStatus
Application.ScreenUpdating = True
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

cms · 27. Mai 2006

Ja vielen Dank Karin!
Der Code hat mir sehr geholfen.
Habs gleich geschafft ihn zu implementieren und mit wenigen Änderungen bekomme ich jetzt genau die Ergebnisse auf die ich gehofft habe.

Ein Problem habe ich noch:
Ich möchte dass das Makro nur Dateien aus den Unterordnern anzeigt, nicht aber die die genau im Suchordner drin stehen. Kann ich irgendwie einstellen dass er NUR die Subordner durchsucht?

User · 27. Mai 2006

Hallo Hans Bärbel

,

für Version ab 2000
Code:

Option Explicit

Sub Dateiname_Pfad_auslesen()
'**************************************************
'* 07.10.04, 31.07.05; 02.08.05 *
'* erstellt von Ramses Rainer *
'* Anpassungen von Hajo *
'* http://home.media-n.de/ziplies/ *
'**************************************************
' Änderung nicht die Dateien im ersten Ordner
Dim Dateiform As String
Dim InI As Long, TotFiles As Long
Dim Suchpfad As String
Dim OldStatus As Variant
Dim LoLetzte As Long
LoLetzte = 1
Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad definieren", Application.DefaultFilePath)
If Suchpfad = "" Then Exit Sub
Dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.xls")
If Dateiform = "" Then Exit Sub
Application.ScreenUpdating = True
OldStatus = Application.StatusBar
' neue Tabelle anlegen
Sheets.Add After:=Worksheets(Worksheets.Count)
With Application.FileSearch
.LookIn = Suchpfad ' Suchverzeichnis
.SearchSubFolders = True ' suchen auch in Unterverzeichnis
.Filename = Dateiform
If .Execute() > 0 Then
TotFiles = .FoundFiles.Count
Application.StatusBar = "Total " & TotFiles & " gefunden"
For InI = 1 To .FoundFiles.Count
Application.StatusBar = "Datei: " & InI & " von " & TotFiles
If Left(.FoundFiles(InI), InStrRev(.FoundFiles(InI), "\") - 1) Suchpfad Then
' Dateiname in Zelle schreiben
Cells(LoLetzte, 1) = .FoundFiles(InI) ' Dateiname mit Pfad
' ergänzt Dateigröße und Dateidatum
Cells(LoLetzte, 2) = FileLen(.FoundFiles(InI)) ' Dateigröße
Cells(LoLetzte, 3) = FileDateTime(.FoundFiles(InI)) ' Dateidatum
LoLetzte = LoLetzte + 1
End If
Next InI
End If
End With
Application.StatusBar = OldStatus
Application.ScreenUpdating = True
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

MRR · 28. Mai 2006

Hier noch eine Alternative:
Code:

Option Explicit
'Typ für Windows-Dialogfeld zur Ordnersuche
Private Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pIDList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
'Folgenden Funktion benötigen wir zur Ermittlung des gewählten Laufwerks
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Dim Verzeichnisse()
Dim Dateien()
Dim Anzdateien As Long
Dim Ordnername

Sub Einlesen()
Dim Pfad1 As String
Dim Obergrenze As Long
Dim Anzordner As Long
Dim i As Long
Dim Start As Long

Ordnername = Ordnerwählen("Ab welchem Verzeichnis einlesen?")
If Ordnername = False Then Exit Sub
ChDir Ordnername
'Wir gehen eine Ebene nach oben, damit wir von dort in dieses erste Verzeichnis wechseln können
ChDir ".."
If Ordnername "" Then
Anzdateien = 0
Pfad1 = Ordnername 'Arbeitspfad merken
If Right(Ordnername, 1) "\" Then Pfad1 = Pfad1 & "\"
ReDim Verzeichnisse(0) 'Die Hauptebene wird das 0. Element
Verzeichnisse(0) = Pfad1
Obergrenze = UBound(Verzeichnisse)
ReDim Dateien(0)

Rekursion:
For i = Start To Obergrenze
Verzeichnisse_suchen Verzeichnisse(i), Obergrenze
Start = Start + 1
Obergrenze = UBound(Verzeichnisse)
GoTo Rekursion
Next
Anzordner = Obergrenze + 1 'Für Anzeige; da Array mit 0 beginnt, 1 dazu

'Lies in ein zweites Array alle Dateien aller gefundenen Verzeichnisse ein
'Damit das Dateien-Array auch entsprechend erweitert werden kann, übergeben wir
'die aktuelle Obergrenze als Startwert für neue Arrayelemente
For i = 1 To Obergrenze 'Wir beginnen bei 1, weil wir das Startverzeichnis nicht mit behandeln wollen
Suche_Dateien Verzeichnisse(i), UBound(Dateien)
Next

'War die Dateisuche erfolglos?
If UBound(Dateien) = 0 Then
If Len(Dateien(0)) = 0 Then
MsgBox "In keinem der " & Anzordner & " Ordner konnte eine Datei gefunden werden. " & vbCr & _
"Es gibt nichts zu tun!", vbInformation + vbOKOnly, "Keine Dateien"
End If
Else
'Wir nehmen die letzte Ebene, die ein leeres Feld enthält, wieder raus.
'Aber nur, wenn überhaupt Dateien vorhanden waren.
'Die Ebene wurde jeweils in Suche_Dateien erhöht.
ReDim Preserve Dateien(UBound(Dateien) - 1)
'Ab hier könnten natürlich sinnvoller Befehle folgen, als die Dateien nur aufzulisten...
For i = 0 To UBound(Dateien)
Cells(i + 1, 1).Value = Dateien(i)
Next
End If
End If
End Sub

Private Sub Verzeichnisse_suchen(ByVal Pfad As String, ByVal Arraygrenze As Long)
'Lies die Verzeichnisse in Pfad ein. Die Prozedur wird in OK_Click "rekursiv" aufgerufen,
'so dass wir ab einem Startverzeichnis eine Struktur einlesen können.
Dim Name1 As String
Name1 = Dir(Pfad, vbDirectory) ' Ersten Eintrag abrufen.
Do While Name1 "" ' Schleife beginnen.
' Aktuelles und übergeordnetes Verzeichnis ignorieren.
If Name1 "." And Name1 ".." Then
'Ist die gefundene Datei ein Verzeichnis?
If (GetAttr(Pfad & Name1) And vbDirectory) = vbDirectory Then
Arraygrenze = Arraygrenze + 1
ReDim Preserve Verzeichnisse(Arraygrenze)
Verzeichnisse(Arraygrenze) = Pfad & Name1 & "\"
End If
End If
Name1 = Dir 'Nächstes Verzeichnis finden
Loop
End Sub

Private Sub Suche_Dateien(ByVal Pfad As String, ByVal Arraygrenze As Long)
'Suche nach allen XL-Dateien im angegebenen Pfad
Dim Name2 As String
Name2 = Dir(Pfad & "*.xl*", vbNormal)
Do While Name2 ""
If (GetAttr(Pfad & Name2) And vbNormal) = vbNormal Then
ReDim Preserve Dateien(Arraygrenze + 1)
'Die Ebene, die wir hier vorsorglich schon mal erweitern, wird später wieder entfernt -
'aber erst ganz zum Schluss, wenn keine weiteren Dateien gefunden wurden.
Dateien(Arraygrenze) = Pfad & Name2
Arraygrenze = Arraygrenze + 1
Anzdateien = Anzdateien + 1
End If
Name2 = Dir()
Loop
End Sub

Private Function Ordnerwählen(ByVal strTitle As String) As String
'Stellt ein Windows-Dialogfeld zur Verfügung, mit dem sich ein beliebiger Ordner auswählen läßt.
'Entweder wird dieser oder (bei Abbruch) "" zurückgeliefert.
Dim lngIDList As Long
Dim strBuffer As String
Dim UserBrowseInfo As BrowseInfo
With UserBrowseInfo
.hwndOwner = 0
.lpszTitle = lstrcat(strTitle, "")
.ulFlags = 3
End With
lngIDList = SHBrowseForFolder(UserBrowseInfo)
If (lngIDList) Then
strBuffer = Space(260)
SHGetPathFromIDList lngIDList, strBuffer
strBuffer = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
Ordnerwählen = strBuffer
End If
End Function
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Office: Ordner und Dateien per Makro in Excel auflisten

Ordner und Dateien per Makro in Excel auflisten

Ordner und Dateien per Makro in Excel auflisten

Ordner und Dateien per Makro in Excel auflisten

Ordner und Dateien per Makro in Excel auflisten

Ordner und Dateien per Makro in Excel auflisten - Similar Threads - Ordner Dateien Makro

Nach einer Datei suchen in mehreren Ordnern?

Datei in mehreren Ordnern suchen und wenn gefunden öffnen?! Macro / VBA

Excel Datei an einen Ordner binden

Backup Ordner anlegen und Datei speichern in One Drive

Auf Datein/Ordner im Teams-Chat verweisen (z.B. mit @"Datei")

Datei Upload und Ordner-Einrichtung auf dem Ipad in Teams im Reiter Dateien

Teams: Ordner und Dateien aus OneDrive zur Verfügung stellen