Post by Emilio--------------------------------------------------------------------------
¡Importante!: Colabora con el grupo.Contesta a este mensaje y dinos si te
sirvió o no la respuesta dada. Muchas gracias
--------------------------------------------------------------------------
Hola!
puedes adaptar este código
'*******************************************************************************
'* BuscarArchivos
'* devuelve en una matriz la ruta de todos los archivos contenidos en una
'* carpeta y sus subcarpetas (si así se indica), pudiéndose poner como
filtro
'* una o varias extensiones
'* deberá incluir en la sección de declaraciones de un modulo la siguiente
'* Type Archivo
'* Ruta As String
'* Nombre As String
'* End Type
'* Argumentos: strCarpeta => Ruta de la carpeta en que buscar
'* MatrizArchivos => (Pasada/devuelta) Matriz con las rutas
de los
'* archivos que cumplen las condiciones
'* blnSubCarpetas => Recorrer subcarpetas (S/N)
'* blnReset => Siempre True (resetea el proceso recursivo)
'* strExtension => Matriz de parámetros con las extensiones
'* buscadas, puede ser ninguna, una o varias
'* uso: BuscarArchivos BuscarArchivos "D:\Mis documentos\Bases de Datos",
MatrizArchivos, True, True, "mdb", "zip"
'* adaptación de mostrarArchivosWSH de Juan M. Afán de Ribera (Septiembre
2003)
'* ESH 08/12/06 18:13
'* ESH 26/09/07 19:05 cambio la estructura de la matriz para usar un "tipo"
'* ESH 07/06/09 10:08 corrijo otro gazapo
'*******************************************************************************
Public Sub BuscarArchivos(strCarpeta As String, MatrizArchivos() As
Archivo, blnSubCarpetas As Boolean, blnReset As Boolean, ParamArray
strExtension() As Variant)
Dim fso As Object, _
Carpeta As Object, _
subCarpeta As Object, _
Archivos As Object, _
Archivo As Object
Static strExtensiones As String, _
i As Long
On Error GoTo BuscarArchivos_TratamientoErrores
DoCmd.Hourglass True
' si no se ha pasado ruta de carpeta salgo
If Nz(strCarpeta, vbNullString) = vbNullString Then
Exit Sub
End If
' si se ha pasado alguna extensión a buscar, la primera vez construyo una
cadena con las extensiones
If blnReset Then
strExtensiones = vbNullString
If Not UBound(strExtension) Then
' construyo una cadena con las extensiones(formato .Extensión) para
realizar la comparación
For i = 0 To UBound(strExtension)
strExtensiones = strExtensiones & "." & strExtension(i) & ","
Next i
' elimino la ultima coma sobrante
strExtensiones = Left(strExtensiones, Len(strExtensiones) - 1)
End If
' reseteo el contador
i = 0
blnReset = True
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set Carpeta = fso.getFolder(strCarpeta)
Set Archivos = Carpeta.files
' recorro los archivos de la carpeta indicada
For Each Archivo In Archivos
' si se habían seleccionado extensiones añado a la matriz los archivos
que cumplen la condición
' si no, añado todos
If Not strExtensiones = vbNullString Then
' compruebo si la extensión del archivo (con punto) está en la
cadena strExtensiones
If InStr(strExtensiones, "." & fso.GetExtensionName(Archivo.Name)) =
0 Then
GoTo Saltar
End If
End If
' añado una línea a la matriz y le inserto la ruta del archivo
ReDim Preserve MatrizArchivos(i)
MatrizArchivos(i).Ruta = strCarpeta
MatrizArchivos(i).Nombre = Archivo.Name
i = i + 1
Next Archivo
' en caso de que así se indique se recorren las subcarpetas mediante
llamadas recursivas a la misma función
If blnSubCarpetas Then
For Each subCarpeta In Carpeta.SubFolders
' en este caso el parámetro blnReset es siempre False
BuscarArchivos strCarpeta & IIf(Right(strCarpeta, 1) = "\",
vbNullString, "\") & subCarpeta.Name & "\", MatrizArchivos(),
blnSubCarpetas, False, strExtension
Next
End If
DoCmd.Hourglass False
Set Carpeta = Nothing
Set Archivos = Nothing
Set Archivo = Nothing
Set fso = Nothing
On Error GoTo 0
Exit Sub
Select Case Err
Case 9 ' la matriz no tiene dimensiones por que no se encontró
ningun archivo que cumpliera la condición
Case 76 ' la carpeta no existe
MsgBox "La carpeta " & Chr(34) & strCarpeta & Chr(34) & " no
existe", vbCritical + vbOKOnly, "ATENCION"
Case Else
MsgBox "Error " & Err.Number & " en proc.: BuscarArchivos de
Módulo: mdlGeneral (" & Err.Description & ")", vbCritical + vbOKOnly,
"ATENCION"
End Select
Resume BuscarArchivos_Salir
End Sub ' BuscarArchivos
Emilio [MS-MVP Access 2006/9]
miliuco56 ALGARROBA hotmail.com
http://www.mvp-access.com/foro
http://www.mvp-access.es/emilio
Post by Knight99Estoy comenzando a preparar una pequeña aplicación tipo Gestor
Documental, que me permita desde access acceder a los documentos
digitalizados que tengo en cada carpeta.
Ya tengo la materia prima, estructurada en forma de árbol, es decir, un
directorio en el servidor, que he llamado DIGITALIZACION, del que
cuelgan miles de carpetas, todas ellas distintas y nombradas del tipo
OOOO-NNNNNNNNNN, correspondiendo cada una de ellas a un contrato
distinto dentro de un centro contable distinto.
Como os podéis imaginar, en cada una de dichas carpetas tengo los
documentos que tarde o temprano me gustaría ver.
Mi intención es "listar" de algún modo el directorio DIGITALIZACION y
que cada carpeta me la "convierta" en un registro de tabla, para poder
preparar los formularios correspondientes en los que, una vez localizado
un contrato OOOO-0000128 (por ejemplo) poder ver los documentos
existentes en dicha ruta.
No sé si es ciencia ficción lo que quiero hacer o si, por el contrario,
es fácil confeccionar dicha tabla.
¿Cómo puedo hacerlo?. La BBDD no tengo problemas en cuanto a versión,
quiero decir que puedo usar desde 97-2007.
Gracias de antemano.
__________ Información de ESET Smart Security, versión de la base de
firmas de virus 4573 (20091104) __________
ESET Smart Security ha comprobado este mensaje.
http://www.eset.com
__________ Información de ESET Smart Security, versión de la base de
firmas de virus 4573 (20091104) __________
ESET Smart Security ha comprobado este mensaje.
http://www.eset.com
¡Uf!, gracias por el extenso código Emilio. Intentaré adaptarlo.
No he trabajado nunca con los métodos del FSO. ¿Me obligará a instalar