2) pone en el rango 'A2:E2' los titulos para los atributos de los archivos "Ruta", "Nombre", "Tamaño", "Modificado", "Tipo"
3) a partir de la fila 3, vacia los nombres de los archivos que se encuentren (y sus atributos)
En un modulo de codigo 'normal'=> Lista carpetas, subcarpetas y archivos
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
Este otro macro lista todos los atributos de los archivos de una sola carpeta creando otro modulo de código 'normal'=> archivos todos sus atributos
Sub TodosLosAtributos()
Application.FileDialog(msoFileDialogFolderPicker).Show
Directorio = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
Set oShell = CreateObject("Shell.Application")
Set oDir = oShell.Namespace(Directorio)
Application.ScreenUpdating = False
Cells.ClearContents
For y = 0 To 40
Cells(1, y + 1) = oDir.GetDetailsOf(oDir.Items, y)
Next
x = 2
For Each sFile In oDir.Items
For y = 0 To 40
Cells(x, y + 1) = oDir.GetDetailsOf(sFile, y)
Next
x = x + 1
Next
Cells.EntireColumn.AutoFit
End Sub
archivo
https://www.dropbox.com/s/pal0y6nn8g7eeur/20140808_lista_archivos.xlsm
