Autor
Para los que no sepáis que hace el objeto, a grandes trazos es un objeto que permite configurar una serie de filtros para buscar ficheros, ejecuta la búsqueda y devuelve la lista de ficheros que cumplen con los criterios elegidos. Puedes, por ejemplo, pedirle la lista de ficheros "*.zip" que están en el directorio "C:\Temp" y que lo haga de forma recursiva buscando por los subdirectorios.
Después de mucho mirar por la ayuda y consultar al gran oráculo Google, descubrí que no sólo ha dejado de implementarse "Application.FileSearch", además su funcionalidad no ha sido sustituida por ningún otro objeto. Si quieres hacerlo tienes que implementarte a mano tu búsqueda de ficheros.
Entre los resultados de Google estaba el código de varios procedimientos para hacer lo mismo, incluido el que Microsoft proporciona en su web de soporte. Después de revisarlos todos y probar alguno, decidí implementar mi propio objeto FileSearch basándome en el procedimiento FileSearch que había implementado un tal Havrda y que yo encontré en http://www.pcreview.co.uk/forums/application-filesearch-error-t3743946p2.html
A continuación os pongo el objeto que he implementado por si alguno os encontráis con este problema en el futuro. La ventaja que tiene este objeto es que tiene un funcionamiento parecido al que tenía "Application.FileSearch" por lo que los cambios en vuestras macros serán menores que si intentáis adaptar un procedimiento de los muchos que encontraréis por Internet.
classError.cls
Objeto que agrupa el código de error y los mensajes que se producen dentro del objeto classFileSearch.
Código
Option Compare Database
Option Explicit
Public iNumError As Integer
Public sDonde As String
Public sMensaSist As String
Public sMensaApli As String
Private Sub class_initialize()
On Error Resume Next
Limpiar
End Sub
Public Sub Limpiar()
On Error Resume Next
iNumError = 0
sDonde = ""
sMensaSist = ""
sMensaApli = ""
End Sub
Public Sub Copiar(ByRef oObjOrigen As classError)
On Error Resume Next
iNumError = oObjOrigen.iNumError
sDonde = oObjOrigen.sDonde
sMensaSist = oObjOrigen.sMensaSist
sMensaApli = oObjOrigen.sMensaApli
End Sub
classFileSearch.cls
Objeto que realiza la búsqueda de los ficheros. La lista de ficheros encontrados es una colección de objetos "FILE".
Código
Option Compare Database
Option Explicit
Public oError As classError ' Control de errores
Public sDirIniBusqueda As String ' Directorio desde el que iniciar la búsqueda de ficheros
Public sPatronBusqueda As String ' Patrón de búsqueda de ficheros. Por ejemplo: "*.rar"
Public bBusquedaRecursiva As Boolean ' True: Busca recursivamente por los subdirectorios
Public lstListaFicheros As Collection ' Lista de ficheros encontrados que coinciden con el patrón
Private objFileSystem As Object
Private Sub class_initialize()
On Error GoTo ERROR_CLASSINITIALIZE
Set oError = New classError
sDirIniBusqueda = ""
sPatronBusqueda = ""
bBusquedaRecursiva = False
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Exit Sub
ERROR_CLASSINITIALIZE:
oError.iNumError = Err.Number
oError.sMensaSist = Err.Description
oError.sDonde = "classFileSearch.class_initialize()"
oError.sMensaApli = "Error inicializando una instancia de la clase"
End Sub
Private Sub class_terminate()
On Error Resume Next
Set oError = Nothing
Set lstListaFicheros = Nothing
Set objFileSystem = Nothing
End Sub
Public Function Ejecutar() As Integer
On Error GoTo ERROR_EJECUTAR
Dim iIndice As Integer
Dim sDirectorio As String
Dim sFichero As String
If (sDirIniBusqueda = "") Then
oError.iNumError = -9999
oError.sMensaSist = ""
oError.sDonde = "classFileSearch.Ejecutar()"
oError.sMensaApli = "No se ha indicado ninguna ruta de directorio desde la que iniciar la búsqueda"
Ejecutar = -9999
ElseIf (sPatronBusqueda = "") Then
oError.iNumError = -9999
oError.sMensaSist = ""
oError.sDonde = "classFileSearch.Ejecutar()"
oError.sMensaApli = "No se ha indicado ningún patrón de archivo a buscar"
Ejecutar = -9999
Else
'___Comprobar si la colección de ficheros tiene información, y si la tiene borrarla___
Set lstListaFicheros = Nothing
Set lstListaFicheros = New Collection
sDirectorio = Trim(sDirIniBusqueda)
sFichero = sPatronBusqueda
BuscarFicheros sDirectorio, sFichero
If (oError.iNumError = 0) Then
Ejecutar = lstListaFicheros.Count
Else
Ejecutar = -1
End If
End If
Exit Function
ERROR_EJECUTAR:
oError.iNumError = Err.Number
oError.sMensaSist = Err.Description
oError.sDonde = "classFileSearch.Ejecutar()"
oError.sMensaApli = "Error ejecutando la búsqueda de ficheros indicada"
Ejecutar = -1
End Function
Private Sub BuscarFicheros(sDirectorio As String, sFichero As String)
On Error GoTo ERROR_BUSCARFICHEROS
Dim sDirectorioFichero As String
Dim vSubdirectorio As Variant
Dim lstSubdirectorios As New Collection
'___Añade la barra de directorio al final del nombre de directorio si no la tuviera___
If (Right(sDirectorio, 1) <> "\") Then
sDirectorio = sDirectorio & "\"
End If
'___Realiza la búsqueda de ficheros en el directorio actual___
sDirectorioFichero = Dir(sDirectorio & sFichero)
While (sDirectorioFichero <> "")
lstListaFicheros.Add objFileSystem.GetFile(sDirectorio & sDirectorioFichero) 'Añade el fichero a la lista de ficheros encontrados
sDirectorioFichero = Dir
Wend
'___Buscar en los subdirectorios si se ha definido la búsqueda como recursiva___
If (bBusquedaRecursiva) Then
sDirectorioFichero = Dir(sDirectorio & "*", vbDirectory)
While (sDirectorioFichero <> "")
If (sDirectorioFichero <> "." And sDirectorioFichero <> "..") Then
If ((GetAttr(sDirectorio & sDirectorioFichero) And vbDirectory) = 16) Then
lstSubdirectorios.Add sDirectorio & sDirectorioFichero
End If
End If
sDirectorioFichero = Dir
Wend
'___Procesar la lista de subdirectorios___
For Each vSubdirectorio In lstSubdirectorios
BuscarFicheros CStr(vSubdirectorio), sFichero 'Llamada recursiva
If (oError.iNumError <> 0) Then
Exit For
End If
Next
End If
Exit Sub
ERROR_BUSCARFICHEROS:
oError.iNumError = Err.Number
oError.sMensaSist = Err.Description
oError.sDonde = "classFileSearch.BuscarFicheros()"
oError.sMensaApli = "Error en el procedimiento de búsqueda de ficheros"
End Sub
Procedimiento de prueba (.bas)
Esta es una pequeña función que lo único que hace es instanciar un objeto de la clase classFileSearch, lanzar una búsqueda y mostrar el resultado por la ventana de inspección.
Código
Public Function fnMain() As Boolean
Dim objFileSearch As classFileSearch
Dim objFichero As Object
fnMain = True
Set objFileSearch = New classFileSearch
If (objFileSearch.oError.iNumError = 0) Then
'___Configurar los parámetros de búsqueda de fichero___
objFileSearch.sDirIniBusqueda = "E:\Mis documentos"
objFileSearch.sPatronBusqueda = "*.zip"
objFileSearch.bBusquedaRecursiva = True
If (objFileSearch.Ejecutar() > 0) Then '_Se han encontrado ficheros
For Each objFichero In objFileSearch.lstListaFicheros
Debug.Print "Fichero........: " & objFichero.Name
Debug.Print "Directorio.....: " & objFichero.parentfolder
Debug.Print "Nombre completo: " & objFichero.Path
Debug.Print "--------------------------"
Next objFichero
ElseIf (objFileSearch.oError.iNumError = 0) Then '_No hay error => No se han encontrado ficheros
Debug.Print "No hay ficheros que mostrar"
Else '_Error
Debug.Print "<* ERROR *>"
Debug.Print " Lugar del error.......: " & objFileSearch.oError.sDonde
Debug.Print " Número de error.......: " & objFileSearch.oError.iNumError
Debug.Print " Error devuelto por VBA: " & objFileSearch.oError.sMensaSist
Debug.Print " Error de aplicación...: " & objFileSearch.oError.sMensaApli
Debug.Print "--------------------------"
fnMain = False
End If
Else
Debug.Print "<* ERROR *>"
Debug.Print " Lugar del error.......: " & objFileSearch.oError.sDonde
Debug.Print " Número de error.......: " & objFileSearch.oError.iNumError
Debug.Print " Error devuelto por VBA: " & objFileSearch.oError.sMensaSist
Debug.Print " Error de aplicación...: " & objFileSearch.oError.sMensaApli
Debug.Print "--------------------------"
fnMain = False
End If
Set objFileSearch = Nothing
End Function
El código está probado y funciona. No implementa la funcionalidad completa de "Application.FileSearch" pero cubre lo más básico.
Supongo que viendo el código ya os habréis dado cuenta que el Visual Basic no es mi especialidad así que comentarios, sugerencias, críticas constructivas y mejoras serán bienvenidas
En línea
esta bien pero porque se escribe "Option Compare Database"
quiza sera porque mencionas que trabajas con base de datos y eso 
y si la clase funciona, a la biblioteca 
