Listar Carpetas, Archivos, SubCarpetas y Archivos de las SubCarpetas

14/05/2008 - 23:43 por Angelo Vernaza | Informe spam
Hola buenas tardes,

Por favor me ayudan con una macro para listar las Carpetas, archivos,
SubCarpetas y archivos de las SubCarpetas en una Hoja de Excel.

Colocaria en la celda A1, la ruta de de la Carpeta madrea y que me
traiga la información de esta manera:

Columna A = Ruta Carpeta
Columna B = Nombre Archivo
Columna C = Tamaño del Archivo
Columna D = Fecha Modificación
Columna E = Tipo de Archivo

Espero que me puedan ayudar con esto.

Saludos,
Angelo V.
 

Leer las respuestas

#1 Héctor Miguel
15/05/2008 - 05:25 | Informe spam
hola, Angelo !

... macro para listar las Carpetas, archivos, SubCarpetas y archivos de las SubCarpetas en una Hoja de Excel.
Colocaria en la celda A1, la ruta de de la Carpeta madrea y que me traiga la informacion de esta manera:
Columna A = Ruta Carpeta
Columna B = Nombre Archivo
Columna C = Tamaño del Archivo
Columna D = Fecha Modificación
Columna E = Tipo de Archivo



el siguiente ejemplo (que puedes adaptar para otras necesidades)...
1) toma la carpeta predeterminada que pongas en 'A1' (p.e. -> c:uta y\sub-carpeta)
2) pone en el rango 'A2:E2' los titulos para los atributos de los archivos
3) a partir de la fila 3, vacia los nombres de los archivos que se encuentren (y sus atributos)

si cualquier duda (o informacion adicional)... comentas ?
saludos,
hector.

' en un modulo de codigo 'normal' ==
Sub LIsta_de_archivos()
Application.ScreenUpdating = False
Dim Carpeta As String: Carpeta = Range("a1"): Cells.Clear
Range("a2:e2") = Array("Ruta", "Nombre", "Tamaño", "Modificado", "Tipo")
Listar_archivos_en Carpeta, True
End Sub

Sub Listar_archivos_en(Carpeta As String, Completo As Boolean)
Dim Archivo, SubCarpeta, Fila As Long
Fila = Range("a65536").End(xlUp).Row + 1
With CreateObject("scripting.filesystemobject")
With .GetFolder(Carpeta)
For Each Archivo In .Files
With Archivo
Range("a" & Fila & ":e" & Fila) = Array( _
Application.Substitute(.Path, .Name, ""), .Name, .Size, .DateLastModified, .Type)
End With
Fila = Fila + 1
Next
If Completo Then
For Each SubCarpeta In .SubFolders
Listar_archivos_en SubCarpeta.Path, True
Next
End If
End With
End With
Range("a1:e1").EntireColumn.AutoFit
Range("a1") = Carpeta
Debug.Print ActiveSheet.UsedRange.Address
End Sub

Preguntas similares