Hallo,

kopiere folgendes Makro in ein leeres Standardmodul:

Option Explicit

'//Erforderliche Verweise (Extras -> Verweise)
'//-Microsoft Scripting Runtime

'//Konstanten/Settings
'//Startpfad für Auflistung
Private Const PFAD As String = "G:\Test"
'//Arbeitsblatt in dem die Liste erstellt wird
Private Const WORKSHEET_NAME As String = "Tabelle1"

Public Sub getAllFiles()
    Dim fso As New FileSystemObject
    
    If Not fso.FolderExists(PFAD) Then
        MsgBox "Das angegebene Verzeichnis existiert nicht..", vbInformation
        GoTo cleanUp
    End If
    
    Dim wks As Worksheet
    Set wks = Worksheets(WORKSHEET_NAME)
    
    With wks
        .Range("A1") = "Dateiname"
        .Range("B1") = "Hauptfirma"
        .Range("C1") = "Firma"
    End With
    
    listFiles PFAD
    wks.Columns("A:C").AutoFit
    
cleanUp:
    If Not fso Is Nothing Then Set fso = Nothing
    If Not wks Is Nothing Then Set wks = Nothing
End Sub

Private Sub listFiles(ByVal p As String)
    Dim fso As New FileSystemObject
    Dim fo As Folder, fo1 As Folder
    Dim f As File
    
    Set fo = fso.GetFolder(p)
    
    For Each f In fo.Files
        addNewFileToList f.Path
    Next
    
    For Each fo1 In fo.SubFolders
        listFiles fo1.Path
    Next
    
    Set fo = Nothing
    Set fso = Nothing
End Sub

Private Sub addNewFileToList(ByVal p As String)
    Dim fso As New FileSystemObject
    Dim fo As Folder
    Dim wks As Worksheet
    Dim l As Long
    
    Set wks = Worksheets(WORKSHEET_NAME)
    l = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row + 1
    
    With wks
        .Cells(l, 1) = fso.GetFileName(p)
        .Hyperlinks.Add .Cells(l, 1), p
        Set fo = fso.GetFolder(fso.GetParentFolderName(p))
        .Cells(l, 3) = fo.Name
        Set fo = fso.GetFolder(fso.GetParentFolderName(fo.Path))
        .Cells(l, 2) = fo.Name
    End With
    
    Set wks = Nothing
    Set fo = Nothing
End Sub

Bitte den Verweis hinzufügen und die Einstellungen ändern. Anschließend das Makro ausführen.

Gruß