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