Ordnerstruktur aus Explorer auslesen

Public Sub OrdnerListen_Start()

    Dim fso As Object

    

    Dim strPfad As String

    

    With Application.FileDialog(msoFileDialogFolderPicker)

        .Title = "Start-Verzeichnis wählen"

        .ButtonName = "übernehmen"

        If .Show > -1 Then Exit Sub

        strPfad = .SelectedItems(1)

    End With

    

    With ActiveSheet

        

        .UsedRange.ClearContents

    

        Set fso = CreateObject("Scripting.FileSystemObject")

        

        Call OrdnerListen(fso, strPfad, .Range("A2")) ' Pfad anpassen!

        

        Set fso = Nothing

    

    End With

    

End Sub



Private Sub OrdnerListen(fso As Object, Ordnerangabe As String, rng As Range, Optional Zeile As Long, Optional Spalte As Long)

    Dim o, uo

    

    Set o = fso.GetFolder(Ordnerangabe)

        

    rng.Offset(Zeile, Spalte).Value = o.Name

            

    Zeile = Zeile + 1

            

    For Each uo In o.SubFolders

        Spalte = Spalte + 1

        Call OrdnerListen(fso, uo.Path, rng, Zeile, Spalte)

        Spalte = Spalte - 1

    Next

    

    Set o = Nothing

    Set uo = Nothing

    

End Sub