Listar Carpetas, Archivos, SubCarpetas y Archivos de las SubCarpetas

Alguna vez has necesitado hacer un listado de todos los archivos que tienes en una carpeta?

Si tienes esto:

Imagen 1

y pasarlo para ver esto:

Imagen 2

Comparto una macro creada por Hector Miguel.

En un módulo normal vas a pegar el siguiente código. Posteriormente en la celda A1 ingresas la ruta por ejemplo teniendo la carpeta como se observa en la imagen 1 escribimos: D:\Datos Juan A


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

Ejecutamos la macro Lista_de_archivos y listo, el resultado será tal como se ve en la imagen 2.

Saludos

Juan Alejandro