FSO to search until subfolders

Try this:

Option Explicit

Sub FilesInFolderInfo()
  Dim myFolder$
  ' Pick folder
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select a folder to list Files from"
        .InitialFileName = "C:\Temp\Old Folder"                         '<<< Change here
        .Show
        If .SelectedItems.Count > 0 Then myFolder = .SelectedItems(1) & "\" Else Exit Sub
    End With
  ' Loop through all subfolders
    ListFilesInFolder myFolder, True
End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
  Dim r&, fso As Object, SourceFolder, FileItem, SubFolder
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = fso.GetFolder(SourceFolderName)
        r = 1
        For Each FileItem In SourceFolder.Files
          With FileItem
            r = r + 1
            Cells(r, 1) = .Name
            Cells(r, 2) = .Size
            Cells(r, 3) = .DateCreated
            Cells(r, 4) = .DateLastModified
            Cells(r, 5) = .Type
            Cells(r, 6) = .Path
          End With
        Next
            If IncludeSubfolders Then
                For Each SubFolder In SourceFolder.SubFolders
                    ListFilesInFolder SubFolder.Path, True
                Next SubFolder
            End If
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set fso = Nothing
End Sub

abousetta