Esta función busca un archivo en cualquier unidad del pc (incluso en CD-ROM)
Es muchísimo mas rápida que la utilidad "Buscar" del menú inicio de Windows

Código:

Private Declare Function SearchTreeForFile Lib "imagehlp" (ByVal RootPath As String, ByVal InputPathName As String, ByVal OutputPathBuffer As String) As Long
Private Declare Function GetLogicalDrives Lib "kernel32" () As Long

Public Function BuscarArchivo(ArchivoBuscado As String) As String
 Dim sDir As String, lRet As Long
 Dim lDrive As Long, sDrive As String, i As Integer
 Screen.MousePointer = vbHourglass
 lDrive = GetLogicalDrives
 For i = 0 To 25
 ' buscar en todas las unidades
 If (lDrive And 2 ^ i) <> 0 Then
 sDrive = Chr$(65 + i) & ":\"
 sDir = String(260, 0)
 lRet = SearchTreeForFile(sDrive, ArchivoBuscado, sDir)
 If lRet <> 0 Then
 BuscarArchivo =Left$(sDir, InStr(1, sDir, Chr$(0)) - 1)
 Exit For
 End If
 End If
 Next i
 If lRet = 0 Then BuscarArchivo = "No encontrado"
 Screen.MousePointer = vbDefault
End Function

Para llamarla:

Código:

Private Sub Command1_Click()
 Dim s As String
 s = BuscarArchivo(Text1)
 ' En Text1 está el nombre del archivo a buscar (con extensión). No vale *.*
 MsgBox s
End Sub

Espero que le sirva a alguien.
SaludosEdited by: Anibal

Excelente gracias Anibal

Gracias yorch, he modificado un poco la función para que devuelva una cadena con la ruta si encuentra el archivo o un mensaje en caso contrario.

Saludos

Hola. Me es muy util esta funcion y es justo lo que necesito. pero tengo una dificultad. Lo que pasa es que tengo guardado en mi equipo y en otros varios archivos iguales, dado que uso una base movil (que la uso desde un pendrive) y en ocasiones me vi obligado a hacer copias, por respaldo, virus, etc. Lo que me es importante es que solo haya una sola base y no varias diseminadas en todo el equipo.
Con este codigo lo busco al archivo y ciertamente me lo encuentra donde este, pero al haber varios, solo me encuentra el primero y no puedo volver a hacer una busqueda porque me encuentra el primero y para ahi, hasa que lo mueva, elimine o cambie el nombre. Por ejemplo archivo.mdb que esta en: c: , d:/varios, y en e:/bases ,al buscar me encuentra el c:/archivo.mdb y ahi para. lo elimino, hago otra busqueda y me encuentra el c:/varios/archivo.mdb y asi sucesivamente.

Se podria hacer que no pare hasta que haya recorrido todas las unidades y en la lista muestre todas las rutas, o en un txt o algo asi, o que te de la opcion de eliminar, mover o algo.

No soy programador y estoy dando mis primeros pasos en vb y access. me guian un poco...???
emilio

Excelente aporte. Me resultó de mucha ayuda. Pude encontrar un archivo en mi disco duro SSD que no tenía ni idea de donde estaba.

Gracias

Perdona Anibal tome tu función por considerarla mucho mejor que lo que tengo hecho. Pero el caso que no me funciona, me da varios errores y no soy capaz de saber porque.
Si te parece bien pongo el código señalando las lineas de error haber si me puedes ayudar.

Private Declare Function SearchTreeForFile Lib
Private Declare Function GetLogicalDrives Lib


Public Function BuscaArchivo(Fichero As String) As String
Try
Dim sDir As String, sDrive As String
Dim lDrive As Long, lRet As Long
Dim i As Integer
Cursor.Current = Cursors.WaitCursor
lDrive = GetLogicalDrives
For i = 0 To 25 ' buscar en todas las unidades
If (lDrive And CLng((2 ^ i))) <> 0 Then
sDrive = Convert.ToChar(65 + i) & ":\"
sDir = Convert.ToString(260, 0) ' Linea de error "Base no valida"
lRet = SearchTreeForFile(sDrive, Fichero, sDir)
If lRet <> 0 Then
BuscaArchivo = Left$(sDir, InStr(1, sDir, Convert.ToChar(0)) - 1)
Exit For
End If
End If
Next i
If lRet = 0 Then BuscaArchivo = "No encontrado"
Cursor.Current = Cursors.Default
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Function

Muchas gracias y un saludo