Adapt macro to create list of all PDF files in folder, including subfolders.

Slightly different way...

Sub x()
     
    Dim Lines As Variant
    Dim str As String
    
    On Error GoTo ErrHandler
     
        '// c:\temp\test\*.* = Filespec to use for DIR. Parameters are:
        '// *.* = All files
        '// /s = Include sub-folder
        '// /b = 'Bare' listing

        '// Change to suit... Instead of
        '// c:\temp\*.* use
        '// C:\Directory\Name\*.PDF for example.
        str = CreateObject("WScript.Shell").EXEC("cmd /c dir c:\temp\*.* /s /b").stdout.readall
         
         '// Split the returned string into the Array LINES
         '// Delimiter is the Carriage Return/Line Feed pair (vbCrLf)
        Lines = Split(str, vbCrLf)
        
        '// Seeing as you said 'Thousands...'
        If Ubound(Lines) < Rows.Count then
            '// Transpose and write array to worksheet
            Sheet1.Range("A1").Resize(UBound(Lines)) = Application.Transpose(Lines)
        Else
            MsgBox "Too many results to fit on worksheet...", vbExclamation, "Error"
        End If
     
ErrHandler:
     
End Sub

Edit: Ok try this.

Sub ListFiles()
    ReadFilesFolder "F:\Drawings\rcs\", "*.PDF", True
End Sub

Sub ReadFilesFolder(ByVal tFolderName As String, tExtension As String, getSubFolders As Boolean)
    Dim fileName As String
    
    fileName = Dir(tFolderName & tExtension)
    
    Do While fileName <> ""
        ActiveCell.Value = fileName
        ActiveCell.Offset(1, 0).Select
        fileName = Dir
    Loop
    
    Dim FS As New FileSystemObject
    Dim FSfolder As Folder
    Dim subfolder As Folder
    
    If getSubFolders Then
        Set FSfolder = FS.GetFolder(tFolderName)
        
        For Each subfolder In FSfolder.subFolders
            ReadFilesFolder subfolder & "\", tExtension, getSubFolders
        Next subfolder
    End If
End Sub