'Option Explicit
Sub ListarPropiedadesFicherosCarpeta()
' ---&--- www.excelforo.com
Dim Ruta As String
' ---&--- Creamos el objeto FileSystemObject que
' ---&--- proporciona acceso al sistema de archivos de un equipo
Set fso = CreateObject("Scripting.FileSystemObject")
' ---&--- Indicamos la ruta de donde vamos a obtener
' ---&--- los ficheros, en este caso D:\BancoFotos
Ruta = "C:\Tmp\" ' <---- ----- ----- Aquí tienes que pones la ruta donde estas los ficheros
' ---&--- definimos dos variables que necesitaremos,
' ---&--- para recuperar el nombre de la carpeta, y los ficheros que haya dentro
Set Carpeta = fso.GetFolder(Ruta)
Set ficheros = Carpeta.Files
' ---&--- damos un título en negrita para la celda A1
Range("A1").Value = "Ficheros de la carpeta " & Ruta Range("B1").Value = "Fecha creación" Range("C1").Value = "Fecha último acceso" Range("D1").Value = "Fecha última modificación" Range("E1").Value = "Tipo archivo" Range("F1").Value = "Tamaño en bytes" Range("G1").Value = "Ruta corta" Range("H1").Value = "Nombre corto" Range("I1").Value = "Atributo" Range("J1").Value = "Ruta completa" Range("A1:J1").Font.Bold = True
' ---&--- escribimos los ficheros, a partir de A2
Range("A2").Select For Each archivo In ficheros
' ---&--- escribimos el nombre del fichero
ActiveCell = archivo.Name
ActiveCell.Offset(0, 1) = archivo.DateCreated
ActiveCell.Offset(0, 2) = archivo.DateLastAccessed
ActiveCell.Offset(0, 3) = archivo.DateLastModified
ActiveCell.Offset(0, 4) = archivo.Type
ActiveCell.Offset(0, 5) = archivo.Size
ActiveCell.Offset(0, 6) = archivo.shortpath
ActiveCell.Offset(0, 7) = archivo.shortname
ActiveCell.Offset(0, 8) = archivo.Attributes
ActiveCell.Offset(0, 9) = archivo.Path
' ---&--- bajamos una fila
ActiveCell.Offset(1, 0).Select
Next archivo
Range("A:J").EntireColumn.AutoFit
' ---&--- Limpiamos los objetos y variables definidas
Set fso = Nothing
Set Carpeta = Nothing
Set ficheros = Nothing
Application.ScreenUpdating = True
End Sub
