Dateien und Verzeichnisse inkl. Unterordner auslesen

Option Explicit
Option Compare Text
Const sRootPath As String = "C:\Temp"
Private lRowCounter As Long
Private oSheet As Object
Public Sub DateienMitUnterordnernAuslesen()
         Set oSheet = Sheets.Add
         oSheet.Cells(1, 1).Select
         Call CreateHeadLinesAndFormat
         lRowCounter = 2
         Call ReadSubFolder(sRootPath)
         Set oSheet = Nothing
End Sub
Private Sub CreateHeadLinesAndFormat()
   Dim i As Long
     oSheet.Cells(1, 1) = "Spalte1"
     oSheet.Cells(1, 2) = "Spalte2"
     oSheet.Columns(1).ColumnWidth = 40
     oSheet.Columns(2).ColumnWidth = 40
     For i = 1 To 2
         With oSheet
             .Cells(1, i).Interior.ColorIndex = 11
             .Cells(1, i).Font.Color = vbWhite
             .Cells(1, i).Font.Bold = True
         End With
     Next i
End Sub
Private Sub ReadSubFolder(ByVal sPath As String)
   Dim oFSO As Object
   Dim oFolder As Object
   Dim oSubFolder As Object
   Dim oFile As Object
     Set oFSO = CreateObject("Scripting.FileSystemObject")
     Set oFolder = oFSO.getfolder(sPath)
     With oSheet
         For Each oSubFolder In oFolder.subfolders
             For Each oFile In oSubFolder.Files
                 .Cells(lRowCounter, 1) = oSubFolder.Path
                 .Cells(lRowCounter, 2) = oFile.Name
                 lRowCounter = lRowCounter + 1
             Next oFile
            Call ReadSubFolder(oSubFolder.Path)
         Next oSubFolder
     End With
     Set oFSO = Nothing
     Set oFile = Nothing
     Set oFolder = Nothing
     Set oSubFolder = Nothing
End Sub