Listar atributos de archivos y carpetas (Todos)

Hola boys:

El título lo dice todo.

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


[/CODE]