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.Activate
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