Dateiinventar eines Ordners nach Excel

Sub DateiinventarErstellen()
    Dim dlg As FileDialog, ordner As String, fso As Object, folder As Object, f As Object, ws As Worksheet, r As Long
    Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
    If dlg.Show <> -1 Then Exit Sub
    ordner = dlg.SelectedItems(1)
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(ordner)
    Set ws = Worksheets.Add
    ws.Name = "Dateien_" & Format(Now, "hhnnss")
    ws.Range("A1:D1").Value = Array("Datei", "Pfad", "Bytes", "Geändert")
    r = 2
    For Each f In folder.Files
        ws.Cells(r, 1).Value = f.Name
        ws.Cells(r, 2).Value = f.Path
        ws.Cells(r, 3).Value = f.Size
        ws.Cells(r, 4).Value = f.DateLastModified
        r = r + 1
    Next f
    ws.Columns.AutoFit
End Sub