elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Sigue las noticias más importantes de seguridad informática en el Twitter! de elhacker.NET


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  Visual Basic For Application. Objeto "Application.FileSearch" en Office 2007/10
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: Visual Basic For Application. Objeto "Application.FileSearch" en Office 2007/10  (Leído 6,300 veces)
Aberroncho
Colaborador
***
Desconectado Desconectado

Mensajes: 1.738


Daría todo lo que sé por la mitad de lo que ignoro


Ver Perfil
Visual Basic For Application. Objeto "Application.FileSearch" en Office 2007/10
« en: 25 Octubre 2011, 22:37 pm »

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.

Código
  1. Option Compare Database
  2. Option Explicit
  3.  
  4.  
  5. Public iNumError        As Integer
  6. Public sDonde           As String
  7. Public sMensaSist       As String
  8. Public sMensaApli       As String
  9.  
  10.  
  11. Private Sub class_initialize()
  12.    On Error Resume Next
  13.  
  14.    Limpiar
  15. End Sub
  16.  
  17.  
  18. Public Sub Limpiar()
  19.    On Error Resume Next
  20.  
  21.    iNumError = 0
  22.    sDonde = ""
  23.    sMensaSist = ""
  24.    sMensaApli = ""
  25. End Sub
  26.  
  27. Public Sub Copiar(ByRef oObjOrigen As classError)
  28.    On Error Resume Next
  29.  
  30.    iNumError = oObjOrigen.iNumError
  31.    sDonde = oObjOrigen.sDonde
  32.    sMensaSist = oObjOrigen.sMensaSist
  33.    sMensaApli = oObjOrigen.sMensaApli
  34. End Sub
  35.  
  36.  


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
  1. Option Compare Database
  2. Option Explicit
  3.  
  4.  
  5. Public oError               As classError       ' Control de errores
  6. Public sDirIniBusqueda      As String           ' Directorio desde el que iniciar la búsqueda de ficheros
  7. Public sPatronBusqueda      As String           ' Patrón de búsqueda de ficheros. Por ejemplo: "*.rar"
  8. Public bBusquedaRecursiva   As Boolean          ' True: Busca recursivamente por los subdirectorios
  9. Public lstListaFicheros     As Collection       ' Lista de ficheros encontrados que coinciden con el patrón
  10.  
  11. Private objFileSystem       As Object
  12.  
  13.  
  14. Private Sub class_initialize()
  15.    On Error GoTo ERROR_CLASSINITIALIZE
  16.  
  17.    Set oError = New classError
  18.  
  19.    sDirIniBusqueda = ""
  20.    sPatronBusqueda = ""
  21.    bBusquedaRecursiva = False
  22.  
  23.    Set objFileSystem = CreateObject("Scripting.FileSystemObject")
  24.  
  25.    Exit Sub
  26.  
  27. ERROR_CLASSINITIALIZE:
  28.    oError.iNumError = Err.Number
  29.    oError.sMensaSist = Err.Description
  30.    oError.sDonde = "classFileSearch.class_initialize()"
  31.    oError.sMensaApli = "Error inicializando una instancia de la clase"
  32.  
  33. End Sub
  34.  
  35. Private Sub class_terminate()
  36.    On Error Resume Next
  37.    Set oError = Nothing
  38.    Set lstListaFicheros = Nothing
  39.    Set objFileSystem = Nothing
  40. End Sub
  41.  
  42. Public Function Ejecutar() As Integer
  43.    On Error GoTo ERROR_EJECUTAR
  44.  
  45.    Dim iIndice     As Integer
  46.    Dim sDirectorio As String
  47.    Dim sFichero    As String
  48.  
  49.  
  50.    If (sDirIniBusqueda = "") Then
  51.        oError.iNumError = -9999
  52.        oError.sMensaSist = ""
  53.        oError.sDonde = "classFileSearch.Ejecutar()"
  54.        oError.sMensaApli = "No se ha indicado ninguna ruta de directorio desde la que iniciar la búsqueda"
  55.        Ejecutar = -9999
  56.  
  57.    ElseIf (sPatronBusqueda = "") Then
  58.        oError.iNumError = -9999
  59.        oError.sMensaSist = ""
  60.        oError.sDonde = "classFileSearch.Ejecutar()"
  61.        oError.sMensaApli = "No se ha indicado ningún patrón de archivo a buscar"
  62.        Ejecutar = -9999
  63.    Else
  64.        '___Comprobar si la colección de ficheros tiene información, y si la tiene borrarla___
  65.  
  66.        Set lstListaFicheros = Nothing
  67.        Set lstListaFicheros = New Collection
  68.  
  69.        sDirectorio = Trim(sDirIniBusqueda)
  70.        sFichero = sPatronBusqueda
  71.  
  72.        BuscarFicheros sDirectorio, sFichero
  73.  
  74.        If (oError.iNumError = 0) Then
  75.            Ejecutar = lstListaFicheros.Count
  76.        Else
  77.            Ejecutar = -1
  78.        End If
  79.    End If
  80.  
  81.    Exit Function
  82.  
  83. ERROR_EJECUTAR:
  84.    oError.iNumError = Err.Number
  85.    oError.sMensaSist = Err.Description
  86.    oError.sDonde = "classFileSearch.Ejecutar()"
  87.    oError.sMensaApli = "Error ejecutando la búsqueda de ficheros indicada"
  88.    Ejecutar = -1
  89.  
  90. End Function
  91.  
  92. Private Sub BuscarFicheros(sDirectorio As String, sFichero As String)
  93.    On Error GoTo ERROR_BUSCARFICHEROS
  94.  
  95.    Dim sDirectorioFichero As String
  96.    Dim vSubdirectorio As Variant
  97.    Dim lstSubdirectorios As New Collection
  98.  
  99.  
  100.    '___Añade la barra de directorio al final del nombre de directorio si no la tuviera___
  101.  
  102.    If (Right(sDirectorio, 1) <> "\") Then
  103.        sDirectorio = sDirectorio & "\"
  104.    End If
  105.  
  106.  
  107.    '___Realiza la búsqueda de ficheros en el directorio actual___
  108.  
  109.    sDirectorioFichero = Dir(sDirectorio & sFichero)
  110.  
  111.    While (sDirectorioFichero <> "")
  112.        lstListaFicheros.Add objFileSystem.GetFile(sDirectorio & sDirectorioFichero)   'Añade el fichero a la lista de ficheros encontrados
  113.        sDirectorioFichero = Dir
  114.    Wend
  115.  
  116.  
  117.    '___Buscar en los subdirectorios si se ha definido la búsqueda como recursiva___
  118.  
  119.    If (bBusquedaRecursiva) Then
  120.  
  121.        sDirectorioFichero = Dir(sDirectorio & "*", vbDirectory)
  122.  
  123.        While (sDirectorioFichero <> "")
  124.  
  125.            If (sDirectorioFichero <> "." And sDirectorioFichero <> "..") Then
  126.                If ((GetAttr(sDirectorio & sDirectorioFichero) And vbDirectory) = 16) Then
  127.                    lstSubdirectorios.Add sDirectorio & sDirectorioFichero
  128.                End If
  129.            End If
  130.  
  131.            sDirectorioFichero = Dir
  132.        Wend
  133.  
  134.  
  135.        '___Procesar la lista de subdirectorios___
  136.  
  137.        For Each vSubdirectorio In lstSubdirectorios
  138.            BuscarFicheros CStr(vSubdirectorio), sFichero   'Llamada recursiva
  139.  
  140.            If (oError.iNumError <> 0) Then
  141.                Exit For
  142.            End If
  143.        Next
  144.    End If
  145.  
  146.    Exit Sub
  147.  
  148. ERROR_BUSCARFICHEROS:
  149.    oError.iNumError = Err.Number
  150.    oError.sMensaSist = Err.Description
  151.    oError.sDonde = "classFileSearch.BuscarFicheros()"
  152.    oError.sMensaApli = "Error en el procedimiento de búsqueda de ficheros"
  153.  
  154. End Sub
  155.  
  156.  


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
  1. Public Function fnMain() As Boolean
  2.    Dim objFileSearch   As classFileSearch
  3.    Dim objFichero      As Object
  4.  
  5.  
  6.    fnMain = True
  7.    Set objFileSearch = New classFileSearch
  8.  
  9.    If (objFileSearch.oError.iNumError = 0) Then
  10.  
  11.        '___Configurar los parámetros de búsqueda de fichero___
  12.  
  13.        objFileSearch.sDirIniBusqueda = "E:\Mis documentos"
  14.        objFileSearch.sPatronBusqueda = "*.zip"
  15.        objFileSearch.bBusquedaRecursiva = True
  16.  
  17.        If (objFileSearch.Ejecutar() > 0) Then  '_Se han encontrado ficheros
  18.  
  19.            For Each objFichero In objFileSearch.lstListaFicheros
  20.                Debug.Print "Fichero........: " & objFichero.Name
  21.                Debug.Print "Directorio.....: " & objFichero.parentfolder
  22.                Debug.Print "Nombre completo: " & objFichero.Path
  23.                Debug.Print "--------------------------"
  24.            Next objFichero
  25.  
  26.        ElseIf (objFileSearch.oError.iNumError = 0) Then   '_No hay error => No se han encontrado ficheros
  27.  
  28.            Debug.Print "No hay ficheros que mostrar"
  29.  
  30.        Else    '_Error
  31.  
  32.            Debug.Print "<* ERROR *>"
  33.            Debug.Print "   Lugar del error.......: " & objFileSearch.oError.sDonde
  34.            Debug.Print "   Número de error.......: " & objFileSearch.oError.iNumError
  35.            Debug.Print "   Error devuelto por VBA: " & objFileSearch.oError.sMensaSist
  36.            Debug.Print "   Error de aplicación...: " & objFileSearch.oError.sMensaApli
  37.            Debug.Print "--------------------------"
  38.  
  39.            fnMain = False
  40.        End If
  41.    Else
  42.        Debug.Print "<* ERROR *>"
  43.        Debug.Print "   Lugar del error.......: " & objFileSearch.oError.sDonde
  44.        Debug.Print "   Número de error.......: " & objFileSearch.oError.iNumError
  45.        Debug.Print "   Error devuelto por VBA: " & objFileSearch.oError.sMensaSist
  46.        Debug.Print "   Error de aplicación...: " & objFileSearch.oError.sMensaApli
  47.        Debug.Print "--------------------------"
  48.  
  49.        fnMain = False
  50.    End If
  51.  
  52.    Set objFileSearch = Nothing
  53. End Function
  54.  
  55.  


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

"La ignorancia es la noche de la mente, pero una noche sin Luna ni estrellas."
(Confucio)
x64core


Desconectado Desconectado

Mensajes: 1.908


Ver Perfil
Re: Visual Basic For Application. Objeto "Application.FileSearch" en Office 2007/10
« Respuesta #1 en: 25 Octubre 2011, 22:58 pm »

;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


En línea

raul338


Desconectado Desconectado

Mensajes: 2.633


La sonrisa es la mejor forma de afrontar las cosas


Ver Perfil WWW
Re: Visual Basic For Application. Objeto "Application.FileSearch" en Office 2007/10
« Respuesta #2 en: 25 Octubre 2011, 23:43 pm »

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 que incluye comodines "?" y "*" :)
En línea

Aberroncho
Colaborador
***
Desconectado Desconectado

Mensajes: 1.738


Daría todo lo que sé por la mitad de lo que ignoro


Ver Perfil
Re: Visual Basic For Application. Objeto "Application.FileSearch" en Office 2007/10
« Respuesta #3 en: 26 Octubre 2011, 20:00 pm »

;D esta bien pero porque se escribe "Option Compare Database"


"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.
En línea

"La ignorancia es la noche de la mente, pero una noche sin Luna ni estrellas."
(Confucio)
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines