Attribute VB_Name = "mit_Phad"
Option Explicit

Sub List_Files_in_all_folder2()
'   jedes Unterverzeichnis in eine Spalte ergänzt
'   Original für einschl unterordner von Ramses Rainer
    Dim Dateiform As String
    Dim J As Integer
    Dim Bereich As Range
    Dim Dateiname As String
    J = 1
    Dim I As Long, TotFiles As Long
    Dim Suchpfad As String
    Dim OldStatus As Variant
    Dim L As Integer
    Suchpfad = InputBox("Geben Sie den Ordner an, der durchsucht werden soll.", "Pfad definieren", "L:\KONST\")
    If Suchpfad = "" Then Exit Sub
    Dateiform = InputBox("Geben Sie den Dateityp an der gesucht werden soll", "Dateierweiterung", "*.pdf")
    If Dateiform = "" Then Exit Sub
    Application.ScreenUpdating = True
    OldStatus = Application.StatusBar
    With Application.FileSearch
        .LookIn = Suchpfad
        .SearchSubFolders = True        ' auch in Unterorndner Suchen
        .Filename = Dateiform
        If .Execute() > 0 Then
            TotFiles = .FoundFiles.Count
            Application.StatusBar = "Total " & TotFiles & " gefunden"
            For I = 1 To .FoundFiles.Count
                '   ergänzt  für Unterverzeichnis
                '   festellen aller Unterverzeichnisse und in Zeile 1 schreiben
                '   feststellen des Verzeichnisses
                For L = Len(.FoundFiles(I)) To 1 Step -1
                    If Mid(.FoundFiles(I), L, 1) = "\" Then Exit For
                Next L
                Set Bereich = ActiveSheet.Range("A1:IV256").Find(Mid(.FoundFiles(I), 1, L), lookat:=xlWhole)
                If Bereich Is Nothing Then
                    Cells(1, J) = Mid(.FoundFiles(I), 1, L)
                    J = J + 1
                    If J > 256 Then MsgBox "Es sind mehr als 256 Unterverzeichnisse": GoTo Ende
                End If
                ' *****
            Next I
            '   Dateienfeststellen
            For I = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
                Dateiname = Dir(Cells(1, I) & Dateiform)
                Do While Dateiname <> ""
                    ' **** Ergänzung Hyperlink
                    ActiveSheet.Hyperlinks.Add Anchor:=Cells(Cells(Rows.Count, I).End(xlUp).Row + 1, I), _
                        Address:=Cells(1, I) & Dateiname, TextToDisplay:=Dateiname
                    ' *****
                    Dateiname = Dir
                Loop
            Next I
        End If
    End With
Ende:
    Application.StatusBar = OldStatus
    Application.ScreenUpdating = True
End Sub