[Visual Basic] Excel Makro Dateien aus Verzeichnis auflisten und verlinken

Sub ordner_eigenschaften()
 Dim i As Long
 Dim j As Integer
 Dim objShell As Object
 Dim BrowseDir, fso, fsof, fsof_
 Dim strVerzeichnis As String
 Dim fi As Long
 Dim fs As Object
 Set objShell = CreateObject("Shell.Application")
 Dim Eigenschaften()
 Eigenschaften = Array(0, 1, 2, 3, 4, 5, 6, 8, 9, 10, 11, 14, 35, 36, 37, 38, 39)
 '#####################
 'dieser Bereich kann dann wegelassen werden
 'wenn du übergabe in der Funktion erfolgt (Pfad)
 Set BrowseDir = objShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
 On Error Resume Next
 strVerzeichnis = BrowseDir.Items().Item().Path
 If Err.Number <> 0 Then
 Exit Sub
 End If
 '####################
 Cells.Clear
 Set objFolder = objShell.Namespace("" & strVerzeichnis & "")
 For Each strFileName In objFolder.Items
 If Trim(objFolder.GetDetailsOf(strFileName, 2)) <> "Dateiordner" Then
 For j = 0 To UBound(Eigenschaften)
 H_add = Trim(strVerzeichnis) & "\" & Trim(strFileName)
 ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 2, 1), Address:=H_add, TextToDisplay:=H_add
 Cells(i + 2, j + 2).Value = Trim(objFolder.GetDetailsOf(strFileName, Eigenschaften(j)))
 Next
 i = i + 1
 End If
 Next
 Set fs = CreateObject("Scripting.FileSystemObject")
 Set fso = fs.GetFolder(strVerzeichnis)
 Set fsof = fso.SubFolders
 For Each fsof_ In fsof
 Set objFolder = objShell.Namespace("" & fsof_ & "")
 For Each strFileName In objFolder.Items
 If Trim(objFolder.GetDetailsOf(strFileName, 2)) <> "Dateiordner" Then
 For j = 0 To UBound(Eigenschaften)
 H_add = Trim(fsof_) & "\" & Trim(strFileName)
 ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 2, 1), Address:=H_add, TextToDisplay:=H_add
 Cells(i + 2, j + 2).Value = Trim(objFolder.GetDetailsOf(strFileName, Eigenschaften(j)))
 Next
 i = i + 1
 End If
 Next
 Next
 Cells(1, 1) = "Name"
 For j = 0 To UBound(Eigenschaften)
 Cells(1, j + 2) = objFolder.GetDetailsOf(, Eigenschaften(j))
 Next
 Columns.AutoFit
 Columns(3).Replace What:="KB", Replacement:="", LookAt:=xlPart, _
 SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
 ReplaceFormat:=False
 
 Lastrow = Cells(Rows.Count, 1).End(xlUp).Row + 1
 Cells(Lastrow + 1, 2).Value = "Anzahl Dateien:"
 Cells(Lastrow + 1, 3).Value = WorksheetFunction.CountA(Range("C2:C" & Lastrow - 1))
 Cells(Lastrow + 2, 2).Value = "Speicherbedarf:"
 Cells(Lastrow + 2, 3).Value = WorksheetFunction.Sum(Range("C2:C" & Lastrow - 1))
End Sub