Trasladar estructura de carpetas a Excel

[Taribo007]

Prueba esta funcion que he adaptado de access:

Public Function ListarArchivosCarpeta(NombreCarpeta)
Dim fso As Object
Dim carpeta As Object
Dim Archivo As Object
Dim ListaArchivos As String
Dim fila As Integer
Dim Columna As Integer

Columna = 1
fila = 0


Set fso = CreateObject("Scripting.FileSystemObject")
Set carpeta = fso.GetFolder(NombreCarpeta)

'Recorremos la carpeta
For Each Archivo In carpeta.Files
'Buscamos en los archivos de la carpeta
fila = fila + 1
ActiveSheet.Cells(fila, Columna).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=NombreCarpeta & "\" & Archivo.Name, _
TextToDisplay:=Archivo.Name
Next

Set carpeta = Nothing
Set Archivo = Nothing
Set fso = Nothing
End Function

Y la llamas asi:

Call ListarArchivosCarpeta("C:\demo")

Un saludo