Te dejo el código que había hecho para una respuesta anterior, hace lo que necesitas (de forma general), quedo pendiente de tu éxito. Saludos
Sub ListarArchivos()
''Creada por FSerrano en 110624 para takki en TodoExpertos.com
''Lista todos los archivos contenidos en la carpeta especificada, incluyendo subcarpetas
'define una matriz para guardar las subcarpetas que encuentre
Dim subcarpetas() As String
'Captura la ubicación inicial para volver a ella al final del proceso
COMIENZO = ActiveCell.Address
'Inserta una fila para ubicar los títulos
ActiveCell.EntireRow.Insert
'Si esta en la fila 1 se mueve a la segunda
If ActiveCell.Row = 1 Then
ActiveCell.Offset(1, 0).Activate
End If
'Inserta los títulos que identifican las columnas
ActiveCell.Offset(-1, 0) = "ARCHIVO"
ActiveCell.Offset(-1, 1).Value = "TIPO"
ActiveCell.Offset(-1, 2).Value = "RUTA"
i = 0: j = i
'Redimensiona la matriz que contiene las rutas de las subcarpetas
ReDim Preserve subcarpetas(i + 1)
'Solicita la dirección de la carpeta que se quiere analizar
subcarpetas(i) = InputBox("Ingrese la ruta de la carpeta raíz que quiere listar", UBICACIÓN")
'Control para la selección de la opción 'CANCELAR'
If subcarpetas(i) = "" Then
Exit Sub
End If
i = i + 1
'Ejecuta el ciclo mientras el valor de la posición actual en la matriz sea distinto de vacío ("")
While subcarpetas(j) <> ""
'Define la carpeta de trabajo como la contenida en la posición actual de la matriz
ChDir (subcarpetas(j))
'Selecciona el primer archivo de la carpeta actual
myfile = Dir(subcarpetas(j) & "\", vbDirectory)
'Transito por los archivos . y .. (redundantes)
myfile = Dir: myfile = Dir
'Configura un archivo script para obtener la información del archivo en proceso
Set fs = CreateObject("Scripting.FileSystemObject")
'Se ejecuta el ciclo mientras el exista un archivo por procesar
While myfile <> ""
'Si el archivo actual es una carpeta la ingresa en la matriz, si no, escribe la información
If Not fs.folderexists(Application.WorksheetFunction.Substitute(subcarpetas(j) & "\" & myfile, "\\", "\")) Then
ActiveCell = myfile
Set f = fs.GetFile(Application.WorksheetFunction.Substitute(subcarpetas(j) & "\" & myfile, "\\", "\"))
ActiveCell.Offset(0, 1) = f.Type
ActiveCell.Offset(0, 2) = Application.WorksheetFunction.Substitute(subcarpetas(j), "\\", "\")
ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(0, 2),
Address:=Application.WorksheetFunction.Substitute(subcarpetas(j) & "\" & myfile, "\\", "\")
ActiveCell.Offset(1, 0).Activate
myfile = Dir
Else
subcarpetas(i) = Application.WorksheetFunction.Substitute(subcarpetas(j)& "\" & myfile, "\\", "\")
i = i + 1
ReDim Preserve subcarpetas(i)
myfile = Dir
End If
Wend
j =[color=#666666] [/color]j + 1
Wend
Range(COMIENZO).Activate
'Configura el autofiltro en el registro obtenido
If ActiveCell.Row = 1 Then
ActiveCell.Offset(1, 0).Activate
End If
Range(ActiveCell. Offset(-1, 0), ActiveCell. SpecialCells(xlLastCell)). AutoFilter
Range(COMIENZO). Activate
End Sub
(el listado de las carpetas que necesitas lo encuentras en la tercera columna, solo hay que eliminar los duplicados)
No olvides finalizar y puntuar la pregunta
como puedo hacer para listar las carpetas dentro de otra, solo carpetas. - Franco Garcia Aiquipa
Ingeniero, tengo un problema, dentro de una carpeta que deseo listar, tengo archivos .mp3, al ejecutar la macro lista todos los archivos .mp3 pero también los metadatos de estos (como las fotos de el album que contiene a cada canción) supongo que estos "archivos" están ocultos en el mp3. Me parece que ud. publicó un código para evitar listar este tipo de metadatos o del sistema. Ojala pueda ayudarme, gracias. - sathanasimperio1 .