Código:
Function PathTo(strFile As String) As String
Dim x As Integer
Dim strDirs As String
Dim strDir As String
Dim strEntry As String
'inicia la búsqueda en c:\
strDirs = "c:\" & vbNullChar
Do While Len(strDirs)
x = InStr(strDirs, vbNullChar)
strDir = Left$(strDirs, x - 1)
strDirs = Mid$(strDirs, x + 1)
'Comprueba si existe el archivo
If Len(Dir$(strDir & strFile)) Then
PathTo = strDir & Dir$(strDir & strFile)
Exit Function
End If
'Obtiene una carpeta o archivo contenido es strdir
strEntry = Dir$(strDir & "*.*", vbDirectory)
Do While Len(strEntry)
'si es una carpeta la asigna a strDirs para búscar dentro de ella
On Local Error Resume Next
If (GetAttr(strDir & strEntry) And vbDirectory) Then
If strEntry <> "." And strEntry <> ".." Then
strDirs = strDirs & strDir & strEntry & "\" & vbNullChar
End If
End If
If Err Then Exit Do
On Local Error GoTo 0
strEntry = Dir$
Loop
Loop
PathTo = ""
End Function
también encontre ocurre un error cuando algún nombre de archivo contiene caracteres no validos, es decir no se si alguna vez han visto que en los nombres de archivos los caracteres son reemplazados por unos cuadritos. cuando un archivo los tiene la función falla por eso le agrege el control de errores, asi si encuentra uno de esos archivos se lo brinca y continua la búsqueda