crear lista en hoja de todas las carpetas que tiene un archivo

hola, daniel !

Poner en una hoja todas las carpetas que tiene una carpeta no archivos
es decir que me cree una lista con la ruta de las carpetas que hay dentro de Ej. C:\Documents and Settings\DANIEL\Escritorio\excel/
solo las carpetas los archivos no

existen varias formas... el siguiente ejemplo es una de ellas:
copia las lineas de codigo que adjunto al final y 'corre' unas pruebas =>pero antes<= ...
1) agrega una referencia en el proyecto a la libreria =>Microsoft Scripting Runtime< [C:\Windows\System\ScrRun.dll]
=> en el editor de vba ... herramientas -> referencias
2) la macro 'limpia' las columnas [enteras] de la celda 'activa' y 'la siguiente' [derecha]
3) 'escribe' [desde la celda activa] un listado de directorios 'a partir' de la ruta especificada
[yo use para el ejemplo =>"c:mis documentos:\"<=]
=>puede ser 'a partir de' un [sub]directorio o una unidad logica 'completa' [raiz]<4) la lista se obtiene 'tal cual' estan 'depositados' en el disco duro [posiblemente 'desordenados']

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

Public fso As New FileSystemObject, Carpeta As Folder, SubCarpeta As Folders, _
Sub_Dir As Variant, TotalCarpetas As Integer, Elemento As Integer, _
Carpetas() As Variant, Matriz() As Variant
Sub ListarCarpetas():
Application.ScreenUpdating = False
Dim Iniciar_en As String
Iniciar_en = "c:\mis documentos\"
Elemento = 0: Range(ActiveCell, ActiveCell.Offset(, 1)).EntireColumn.ClearContents
ActiveCell = "Existen " & ContarCarpetas(Iniciar_en) & " subcarpetas en " & Iniciar_en
For Elemento = 1 To UBound(Carpetas): ActiveCell.Offset(Elemento) = Carpetas(Elemento): Next
ActiveCell.EntireColumn.AutoFit: Application.ScreenUpdating = True
End Sub
Private Function ContarCarpetas(ByVal RutaDeInicio As String) As Integer
If Right(RutaDeInicio, 1) <> "\" Then RutaDeInicio = RutaDeInicio & "\"
On Error GoTo Horrores
Set fso = CreateObject("Scripting.FileSystemObject")
Set Carpeta = fso.GetFolder(RutaDeInicio): Set SubCarpeta = Carpeta.SubFolders
ReDim Preserve Carpetas(Elemento): Carpetas(Elemento) = Carpeta.Path
Elemento = Elemento + 1: TotalCarpetas = SubCarpeta.Count
For Each Sub_Dir In SubCarpeta
TotalCarpetas = TotalCarpetas + ContarCarpetas(RutaDeInicio & Sub_Dir.Name)
Next
FinDeFuncion:
ContarCarpetas = TotalCarpetas
Set SubCarpeta = Nothing: Set Carpeta = Nothing: Set fso = Nothing: Exit Function
Horrores:
Resume FinDeFuncion
End Function