Foro de elhacker.net

Tengo unas bases de datos de Access con macros en Visual Basic for Application hechas en la versión 2003 de Access. Ahora me he puesto a migrarlas a Access 2010 y me he encontrado con una sorpresa: El objeto "Application.FileSearch" dejó de implementarse en VBA a partir de la versión 2007 de Office.

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.

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".

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.

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 ;)

;D esta bien pero porque se escribe "Option Compare Database"
el codigo me funka si la linea no esta :P quiza sera porque mencionas que trabajas con base de datos y eso :P yo la verdad no se casi nada de base de datos y esas cosas :P y pues mejor usaria APIs que un Objeto
las cadena de comprobacion vacia ( "" ) es mejor Vbnullstrings :P ;D

Nunca programe profundamente en VBA. Pero es bueno saberlo :) y si la clase funciona, a la biblioteca :D
Esta prolijo y entendible el codigo ;)

También puedes usar la Clase para Buscar de LeandroA (http://leandroascierto.com/blog/clase-para-buscar/) que incluye comodines "?" y "*" :)

"Option Compare" determina el modo en que se compararán las cadenas de texto. En VBA para Access tiene tres valores posibles:

• Binary: Realiza la comparación utilizando el orde que establece el código ASCII del caracter. Esta opción haría que al ordenar, la 'ñ' y la 'Ñ' vayan después de la Z ya que su código ASCII es mayor.
• Text: Realiza la comparación de forma alfabética atendiendo a la configuración regional del sistema y sin distinguir mayúsculas de minúsculas.
• Database: Realiza la comparación siguiendo el criterio configurado en la base de datos.