Unterordner aus Pfad auslesen

Hallo Ihr Lieben,

ich habe folgendes Problem: Ich möchte gerne von einem Dateinpfad den Namen der dritten Ebene auslesen und in Spalte 4 (D) schreiben. Das Problem ist, dass das nur erfolgen soll/kann, wenn es auch eine dritte Ebene gibt. Wichtig noch: es soll nicht immer "einfach" die letzte Ebene vom Pfad sein.
Wie es aussehen soll seht ihr hier.

Datei Ordner Erstellungsdatum Folder
Test 1.docx C:\Desktop\Test Level 1 18.04.2023 15:57
Test 1.docx C:\Desktop\Test Level 1\Test Level 2.1 18.04.2023 15:56 Test Level 2.1

Mein Code sieht bisher so aus. Für die zweite Ebene klappt es, weil es die immer gibt. Er gibt mir jedoch eine Fehlermeldung zurück, sobald ich die dritte Ebene angezeigt bekommen möchte, weil es die nicht immer gibt.

Sub DateinAuslesen(pfad As String)

'Varibalen dimensionieren
Dim fso As New FileSystemObject
Dim Datei As File
Dim LetzteZeile As Long
Dim pfadkette As String

'Schleife über alle Datein im Ordner
For Each Datei In fso.GetFolder(pfad).Files

'letzte Zeile herausfinden
LetzteZeile = Cells(Rows.Count, 2).End(xlUp).Row + 1

'Ergebnisse in Tabellenblatt eintragen
ActiveSheet.Hyperlinks.Add anchor:=Cells(LetzteZeile, 1), Address:=Datei.Path, TextToDisplay:=Datei.Name
Cells(LetzteZeile, 2).Value = Datei.ParentFolder
Cells(LetzteZeile, 3).Value = Datei.DateCreated

pfadkette = Datei.ParentFolder
Cells(LetzteZeile, 4).Value = Split(pfadkette, "\", -1, vbTextCompare)(2)

Next Datei

End Sub

Hier die Datei mit dem Code: https://www.herber.de/bbs/user/158774.xlsm

Ich denke ich brauche eine Abfrage "gibt es Ebene 2" wenn ja, dann... ansonsten "". Ich weiß nur nicht wie ich das umsetze.

Vielen Dank schon mal im Voraus

Viele Grüße

Jenny

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Jenny,

ungefähr so?:

'Wichtig: mit Verweis auf die "Microsoft Scripting Runtime" Bibliothek
Dim fso As New FileSystemObject

Sub AlleDateien_auslesen()
Dim Pfad As String

'Benutzer Ordner auswählen lassen
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub 'Kein Auswahl, kein Behandlung
        Pfad = .SelectedItems(1) 
    End With

'Tabelle ausgeben/ Neues Tabellenblatt erstellen
    Worksheets.Add
    Range("A1:D1").Value = Array("Datei", "Ordner", "Erstellungsdatum", "Folder") 'Überschriften eintragen
    Dateien_auslesen Pfad 
    Unterordner_auslesen Pfad  'Startpunkt der Behandlung
    Columns("A:D").AutoFit 
End Sub

Sub Unterordner_auslesen(Pfad As String)
Dim SF As Folder

'Schleife über alle SF im Ordner
    For Each SF In fso.GetFolder(Pfad).SubFolders
        Dateien_auslesen SF.Path 'Dateien
        Unterordner_auslesen SF.Path 'Unterordner_auslesen (rekursiv)
    Next SF
End Sub

Sub Dateien_auslesen(Pfad As String)
Dim D As File
Dim Z As Range
Dim Folders

    For Each D In fso.GetFolder(Pfad).Files 'Schleife über alle Dn im Ordner
        Set Z = Cells(Rows.Count, 2).End(xlUp).Offset(1, -1) 'erste freie Zelle (auf Basis Spalte B)
        Folders = Split(D.ParentFolder, "\")
    'Ergebnisse in Tabellenblatt eintragen
        ActiveSheet.Hyperlinks.Add anchor:=Z, Address:=D.Path, TextToDisplay:=D.Name
        Z.Offset(0, 1).Value = D.ParentFolder
        Z.Offset(0, 2).Value = D.DateCreated
        If UBound(Folders) >= 2 Then Z.Offset(0, 3).Value = Folders(2)
        If UBound(Folders) >= 3 Then Z.Offset(0, 4).Value = Folders(3)
    Next D
End Sub

Achte auf ein sauberes Einrücken, die Lesbarkeit zuliebe (und das Erkennen von Fehler auch)
Kommentiere nicht, was selbstverständlich oder selbstklärend ist.

VG
Yal

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread