Listar Carpetas, Archivos, SubCarpetas y Archivos de las SubCarpetas

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

On May 14, 10:25 pm, "Héctor Miguel"
wrote:

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

Excelente Muchas Gracias Héctor.

Saludos,

Hola Héctor Miguel
... una macro sensacional
... sin palabras
nunca sobra un agradecimiento creo

un saludo
Pedro J.

Posdata:
Por cierto, tu frase
... si tienes algun dato mas "en el tintero" ? (es hora de comentarlo)
me ha hecho recordar viejas cosashacia tiempo que no la escuchaba...

hola, Pedro !

(gracias por los comentarios) ;)

Posdata:
Por cierto, tu frase
... si tienes algun dato mas "en el tintero" ? (es hora de comentarlo)
me ha hecho recordar viejas cosashacia tiempo que no la escuchaba...

:))

saludos,
hector.

Héctor Miguel escribió el 15/05/2008 22:48 :

hola, Pedro !

(gracias por los comentarios) ;)

Posdata:
Por cierto, tu frase
... si tienes algun dato mas "en el tintero" ? (es hora de
comentarlo)
me ha hecho recordar viejas cosashacia tiempo que no la escuchaba...

:))

saludos,
hector.

Casi 3 años después... excelente código.

Soy nuevo en vba y por cosas coorporativas es mi única herramienta para hacer desarrollios, trabajo bajo office 2007 y quisiera saber si aún podemos contar con tus valiosos aportes?.

Un saludo desde Colombia