Moin!
Hier mal dein Code zurück. Beim Auslesen der Namen habe ich noch ergänzt, dass an den Namen das Erstellungsdatum angehängt wird.

Nach dem Eintrag in Spalte 1 wird der Wert dann aufgesplittet. Sollte klappen, ist aber ungetestet.

Option Explicit
Private strList() As String
Dim varFolder As Variant
Private lngCount As Long
Dim strTMP As String
Public Sub Dateinamen()
Dim zeile As Long
Dim temp
            Columns("A:C").EntireColumn.Hidden = True
 
    lngCount = 0
    'strTMP = GetFolder()
    strTMP = "D:\test" ' so für festen Pfad
    If strTMP = "" Or Left(strTMP, 1) = ":" Then Exit Sub
    SearchFiles strTMP, "*.pdf"
    'SearchFiles strTMP, "*.ppt", True 'so MIT Unterordner
    If Right(strTMP, 1) <> "\" Then strTMP = strTMP & "\"
    If lngCount = 0 Then
        MsgBox "No file found"
        Exit Sub
    End If
    With ThisWorkbook.Worksheets(1)
        .Columns(1).Clear
        .Range(.Cells(3, 1), Cells(lngCount + 2, 1)) = _
            WorksheetFunction.Transpose(strList)
    .Columns("A").AutoFit
    Columns("A:C").EntireColumn.Hidden = True
    For zeile = 3 To lngCount + 2
        temp = .Cells(zeile, 1)
        .Cells(zeile, 1) = Split(temp, "#+#")(0)
        .Cells(zeile, 7) = Split(temp, "#+#")(1)
    Next
    
    End With
    Call Make_Link
    Set varFolder = Nothing
End Sub
Private Function GetFolder() As String
    Dim objShell As Object
    Dim strPath As String
    Set objShell = CreateObject("Shell.Application")
    Set varFolder = objShell.BrowseForFolder(0, "Folder", &H4000, 17)
    If varFolder Is Nothing Then
        Set varFolder = Nothing
        Set objShell = Nothing
        Exit Function
    End If
    GetFolder = varFolder.Self.Path
    Set objShell = Nothing
End Function
Private Sub SearchFiles(strFolder As String, strFileName As String, Optional blnSubFolder As Boolean = False)
    Dim objFolder As Object
    Dim objFile As Object
    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    For Each objFile In objFSO.GetFolder(strFolder).Files
        If objFile.Name Like strFileName Then
            ReDim Preserve strList(lngCount)
            strList(lngCount) = objFile.Name & "#+#" & objFile.DateCreated
            lngCount = lngCount + 1
        End If
    Next
    If blnSubFolder = True Then
        For Each objFolder In objFSO.GetFolder(strFolder).Subfolders
            SearchFiles strFolder & "\" & objFolder.Name, strFileName
        Next objFolder
    End If
End Sub
Public Sub Make_Link()
    Dim lngRow As Long
    With ThisWorkbook.Worksheets(1)
        lngRow = .Range("A" & .Rows.Count).End(xlUp).Row
        For lngRow = 2 To lngRow
            .Hyperlinks.Add Anchor:=.Cells(lngRow, 1), _
                Address:=strTMP & .Cells(lngRow, 1)
        Next lngRow
    End With
End Sub

VG