Código para buscar archivos

Prueba con esto:
Option Explicit
'declaraciones 32-bit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Sub ListFiles()
Dim Msg As String
Dim Directory As String
Dim r As Long, i As Long
Msg = "Seleccionar una localización que contenga los archivos que quiere poner en lista."
Directory = GetDirectory(Msg)
If Directory = "" Then Exit Sub
If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
' Insertar encabezados
r = 1
Cells.ClearContents
Cells(r, 1) = "NombreArchivo"
Cells(r, 2) = "Tamaño"
Cells(r, 3) = "Fecha/Hora"
Range("A1:C1").Font.Bold = True
r = r + 1
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = Directory
.Filename = "*.*"
.SearchSubFolders = False
.Execute
For i = 1 To .FoundFiles.Count
Cells(r, 1) = .FoundFiles(i)
Cells(r, 2) = FileLen(.FoundFiles(i))
Cells(r, 3) = FileDateTime(.FoundFiles(i))
r = r + 1
Next i
End With
End Sub
Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
' Fichero matriz= Desktop
bInfo.pidlRoot = 0&
' Título en el diálogo
If IsMissing(Msg) Then
bInfo.lpszTitle = "Seleccionar una carpeta."
Else
bInfo.lpszTitle = Msg
End If
' Escribir del ditectorio para volver
bInfo.ulFlags = &H1
' Mostrar el diálogo
x = SHBrowseForFolder(bInfo)
' Analizar el resultado
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function
Por falta de tiempo tienes que modificarla a tus necesidades.
[email protected]

gracias por tu ayuda pegue el código que gentilmente me haz enviado pero me presenta el siguiente mensaje " los comentarios solo pueden aparecer despues del end sub end funtcion o end property" resalta en azul esta parte del código
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Agradezco tu tiempo y ayuda