Problema con File System Object - getfolder
Publicado por Alfanhui (5 intervenciones) el 24/04/2014 10:09:06
Hola a todos:
Estoy intentando listar todos los directorios, subdirectorios y ficheros de la empresa en una tabla para eliminar información obsoleta y, con la ayuda de ejemplos que he visto en Internet, he creado un procedimiento que llama recursivamente al método getfolder de File System Object. La cuestión es que funciona bien mientras la ruta completa de cada carpeta tiene 259 caractéres como máximo, sin embargo, si el path tiene 260 caracteres, salta la carpeta activa y subcarpetas y continua ejecutándose como si nada (pero obviando todas estas carpetas y subcarpetas).
¿Le ha ocurrido a alguien alguna vez esta situación? ¿Cómo podría burlar el problema y conseguir que me liste todas las carpetas y subcarpetas?
Os adjunto el código por si os sirve de ayuda. Un saludo y muchas gracias.
Sub VolcarObjetosATabla(nomcarpeta, nomtabla As String)
' Procedimiento que crea una tabla que contendrá los ficheros, carpetas, subcarpetas y ficheros de una carpeta dada
Dim fso As FileSystemObject
Dim carpeta As Folder ' Carpeta
Dim subcarpeta As Folder ' contendrá a cada vez una subcarpeta de la carpeta raiz
Dim archivo As File
Dim archivos As Files ' Colección de archivos
Dim bd As Database
Dim rs As Recordset
Dim strSQL As String
Set fso = CreateObject("scripting.filesystemobject") ' Fijamos objeto fso
Set carpeta = fso.GetFolder(nomcarpeta) ' Obtenemos la carpeta pasada como parámetro.
Set archivos = carpeta.Files ' Asignamos la colección de ficheros de esa carpeta
strSQL = "Select * from [" & nomtabla & "]" ' Consulta para apertura del Recordset
Set bd = CurrentDb ' Asignamos a la variable la base de datos activa
Set rs = bd.OpenRecordset(strSQL) ' y abrimos el recordset
' Agregamos el registro con información de la carpeta activa
With rs
.AddNew
!Nombre = carpeta.Name
!ruta = carpeta.Path
.Update
End With
' y agregamos los ficheros que contiene cada carpeta
For Each archivo In archivos
With rs
.AddNew
!Nombre = archivo.Name
!ruta = archivo.Path
.Update
End With
Next
Set archivos = Nothing ' Desasignamos la colección de archivos
' y finalmente hacemos la llamada recursiva para que se listen las subcarpetas con sus respectivos ficheros
For Each subcarpeta In carpeta.SubFolders
Call VolcarObjetosATabla(nomcarpeta & "\" & subcarpeta.Name, nomtabla)
Next
Set carpeta = Nothing ' y finalmente, desasignamos
Set fso = Nothing
End Sub
Estoy intentando listar todos los directorios, subdirectorios y ficheros de la empresa en una tabla para eliminar información obsoleta y, con la ayuda de ejemplos que he visto en Internet, he creado un procedimiento que llama recursivamente al método getfolder de File System Object. La cuestión es que funciona bien mientras la ruta completa de cada carpeta tiene 259 caractéres como máximo, sin embargo, si el path tiene 260 caracteres, salta la carpeta activa y subcarpetas y continua ejecutándose como si nada (pero obviando todas estas carpetas y subcarpetas).
¿Le ha ocurrido a alguien alguna vez esta situación? ¿Cómo podría burlar el problema y conseguir que me liste todas las carpetas y subcarpetas?
Os adjunto el código por si os sirve de ayuda. Un saludo y muchas gracias.
Sub VolcarObjetosATabla(nomcarpeta, nomtabla As String)
' Procedimiento que crea una tabla que contendrá los ficheros, carpetas, subcarpetas y ficheros de una carpeta dada
Dim fso As FileSystemObject
Dim carpeta As Folder ' Carpeta
Dim subcarpeta As Folder ' contendrá a cada vez una subcarpeta de la carpeta raiz
Dim archivo As File
Dim archivos As Files ' Colección de archivos
Dim bd As Database
Dim rs As Recordset
Dim strSQL As String
Set fso = CreateObject("scripting.filesystemobject") ' Fijamos objeto fso
Set carpeta = fso.GetFolder(nomcarpeta) ' Obtenemos la carpeta pasada como parámetro.
Set archivos = carpeta.Files ' Asignamos la colección de ficheros de esa carpeta
strSQL = "Select * from [" & nomtabla & "]" ' Consulta para apertura del Recordset
Set bd = CurrentDb ' Asignamos a la variable la base de datos activa
Set rs = bd.OpenRecordset(strSQL) ' y abrimos el recordset
' Agregamos el registro con información de la carpeta activa
With rs
.AddNew
!Nombre = carpeta.Name
!ruta = carpeta.Path
.Update
End With
' y agregamos los ficheros que contiene cada carpeta
For Each archivo In archivos
With rs
.AddNew
!Nombre = archivo.Name
!ruta = archivo.Path
.Update
End With
Next
Set archivos = Nothing ' Desasignamos la colección de archivos
' y finalmente hacemos la llamada recursiva para que se listen las subcarpetas con sus respectivos ficheros
For Each subcarpeta In carpeta.SubFolders
Call VolcarObjetosATabla(nomcarpeta & "\" & subcarpeta.Name, nomtabla)
Next
Set carpeta = Nothing ' y finalmente, desasignamos
Set fso = Nothing
End Sub
Valora esta pregunta


0