Dateien aus Ordnern & Unterordnern auslesen

Sub Einlesen()
Dim sFile As String, sPath As String, CD_Nummer
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Index").Range("A2:D" & ThisWorkbook.Sheets("Index").Range("A65536").End(xlUp).Row + 1).ClearContents
CD_Nummer = Startmenu.TextBox_CD_Nummer
sPath = GetDirectory & "\"
If sPath = "\" Then Exit Sub
sFile = Dir(sPath)
Do While Len(sFile) <> 0
ThisWorkbook.Sheets("Index").Range("a" & ThisWorkbook.Sheets("Index").Range("A65536").End(xlUp).Row + 1) = CD_Nummer    'Pfad
ThisWorkbook.Sheets("Index").Range("b" & ThisWorkbook.Sheets("Index").Range("A65536").End(xlUp).Row) = sFile            'Dateiname
If Left(Right(sFile, 4), 1) = "." Then ThisWorkbook.Sheets("Index").Range("c" & ThisWorkbook.Sheets("Index").Range("A65536").End(xlUp).Row) = LCase(Right(sFile, 4))    'Dateityp
ThisWorkbook.Sheets("Index").Range("d" & ThisWorkbook.Sheets("Index").Range("A65536").End(xlUp).Row) = Right(sPath, Len(sPath) - 2)     'Pfad
sFile = Dir()
Loop
Columns.AutoFit
End Sub