Como listar las distintas subcarpetas que hay dentro de una determinada carpeta.

Actualmente tengo una macro de Excel para listar los ficheros de una carpeta, pero querría listar también las subcarpetas que estén dentro de una determinada carpeta.

¿Es posible?

1 respuesta

Respuesta
1

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

Gracias NEFESE,

Tardo en contestar por las fiesta de Semana Santa.

Repito, gracias, pero yo estoy un poco lerdo en el lenguaje de las macros.

La cuestión es que he copiado tu macro como nueva macro en una hoja de Excel y al querer ejecutarla me sale el mensaje siguiente "Error de compilación: Se esperaba End Sub".

Y en esa misma hoja de Visual Basic me aparecen tres filas de tu macro en rojo:

1) - subcarpetas(i) = InputBox("Ingrese la ruta de la carpeta raíz que quiere listar", UBICACIÓN") -

2) - ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(0, 2), -
3) - Address:=Application.WorksheetFunction.Substitute(subcarpetas(j) & "\" & myfile, "\\", "\")

Supongo que tendré que añadir en algún sitio de dicha macro la celda donde definir la ruta de las carpetas y ficheros que deseo listar, pero no lo identifico.

La ruta a listar es: "C:\Documents and Settings\perillan45\Mis documentos\Mi música", que yo he colocado en A1.

No quiero hacerte perder el tiempo, pero puedes echarme una nueva mano?

Gracias.

Rock an Roll
Elvis Presley
Dico 1
a
b
c
d
e
Clásica
Mozart
a
b
c
d
folclore
Canción Española
Manolo
a
b
c
d

Prueba a bajar este archivo... funciona.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas