23 abril, 2021

LISTAR TODOS LOS ARCHIVOS DE UNA CARPETA Y SUS SUBCARPETAS CON VBA

Hola a todos! Espero que todo vaya bien. 🙂

No tenía pensado escribir hoy un post, pero al final me he animado y aquí estoy!. El motivo de no querer postear es que llevo todo el fin de semana sumergido en los algoritmos genéticos y necesito un poco de descanso.

Pero como ya sabéis que trabajar en Excel para mi es una afición, pues no me ha costado demasiado decidirme.

Hoy vamos a tratar sobre la posibilidad de "listar" todo el contenido de archivos que podamos tener en una carpeta y sus subcarpetas. Listaremos cada archivo con el directorio completo y en formato hipervínculo, de manera que podamos luego buscar el archivo con solo pulsar el enlace.

Esta es una consulta que me llegó hace un año aproximadamente y hoy me he acordado de ella, así que os dejo la macro que le envié al lector como solución.

Como ejemplo me utilizaré a mi mismo. Como es obvio, todos los contenidos, macros, imágenes ... etc, de esta web están almacenados en varias copias de seguridad, en varios equipos y también en la nube, imaginad que quiero listar todos los archivos que tengo en Excel Signum en uno de mis equipos, ¿cómo lo hago?.

Pues afortunadamente para mi, tengo esta macro que me ayudará con la tarea. En realidad una macro y una función, aquí os las dejo:

Sub LISTAR_ARCHIVOS()
'Declaramos variables
Dim sFSO As Object, Directorio As String
Dim dir_Archivo As Variant
'Abrimos ventana de diálogo para seleccionar carpeta
Set dir_Archivo = Application.FileDialog(msoFileDialogFolderPicker)
dir_Archivo.Show
'Si no seleccionamos nada salimos del proceso
If dir_Archivo.SelectedItems.Count = 0 Then
Exit Sub
End If
'Capturamos el directorio del archivo seleccionado
Directorio = dir_Archivo.SelectedItems(1)
'Creamos objeto y ejecutamos función Carpeta
Set sFSO = CreateObject("Scripting.FileSystemObject")
CARPETA sFSO.GetFolder(Directorio)
End Sub

Y esta es la función:

Function CARPETA(ByVal nCarpeta)
'Declaramos variables
Dim j As Long, Subcarpeta As Object
'Con la hoja activa
With ActiveSheet
'Iniciamos dos loop, uno que recorre las carpetas
For Each Subcarpeta In nCarpeta.SubFolders
CARPETA Subcarpeta
Next
j = Application.CountA(.Range("A:A")) + 1
'y otro que recorre los archivos y los indexa y activa hipervínculo
For Each File In nCarpeta.Files
.Cells(j, 1).Select
.Hyperlinks.Add Anchor:=Selection, Address:=File.Path, TextToDisplay:=File.Path
j = j + 1
Next
End With
End Function

Una vez que pulsamos en la macro, nos aparecerá un cuadro de diálogo que nos va a permitir seleccionar la carpeta:

LISTAR TODOS LOS ARCHIVOS DE UNA CARPETA Y SUS SUBCARPETAS CON VBA

Una vez que pulsamos aceptar, entonces se comenzarán a listar todos los archivos en la hoja activa (en este caso la hoja1):

LISTAR TODOS LOS ARCHIVOS DE UNA CARPETA Y SUS SUBCARPETAS CON VBA1

Como podéis observar, esta es una muestra de los archivos de seguridad que tengo de Excel Signum y donde además hemos insertado en cada uno un hipervínculo con la ruta hasta el archivo real.

Se podría mostrar solo el nombre del archivo sin mostrar toda la ruta, simplemente se tendría que modificar TextToDisplay:=File.Path por TextToDisplay:=File.Name

Existen muchos tipos y formas de obtener estos datos con programación, esta es solo una forma, pero es la que suelo usar 🙂

Espero que os resulte útil, y me alegro de haber escrito finalmente el post.

Descarga el archivo de ejemplo pulsando en: LISTAR TODOS LOS ARCHIVOS DE UNA CARPETA Y SUS SUBCARPETAS CON VBA

Comparte este post

46 comentario en “LISTAR TODOS LOS ARCHIVOS DE UNA CARPETA Y SUS SUBCARPETAS CON VBA

  1. Excelente aporte, me encanto, solo una duda cuando tiene varias subcarpetas noto envía la información incompleta ya que borra una parte.

    1. Hola Israel:

      Efectivamente, he tenido que modificar una parte del código para realice correctamente la extracción de todos los archivos.

      Descarga el archivo de nuevo, ahora funciona perfectamente.

      Saludos y gracias por avisar!

  2. Hola,

    Mil gracias por la corrección te quedo genial, me funciono perfectamente para lo que la buscaba, oye que libro me pudieras recomendar para empezar a aprender todo esto de las macros la verdad sacando le provecho te ahorras muchas horas de trabajo.

    Saludos.

    1. Hola Manuel:

      Es sencillo, solo debes especificar una condición en la función carpeta. Primero debes capturar la extención del archivo, esto lo hace asñi:

      MiExt = Right(file.Path, Len(file.Path) - InStrRev(file.Path, "."))

      y luego introduces el If con el operador LIKE haciendo referencia a toda extensión que contenga xls, así:

      If MiExt Like "*xls*" Then

      En resumen, la función modificada sería esta:

      Function CARPETA(ByVal nCarpeta)
      'Declaramos variables
      Dim j As Long, Subcarpeta As Object
      'Con la hoja activa
      With ActiveSheet
      'Iniciamos dos loop, uno que recorre las carpetas
      For Each Subcarpeta In nCarpeta.SubFolders
      CARPETA Subcarpeta
      Next
      j = Application.CountA(.Range("A:A")) + 1
      'y otro que recorre los archivos y los indexa solo .xls y activa hipervínculo
      For Each file In nCarpeta.Files
      MiExt = Right(file.Path, Len(file.Path) - InStrRev(file.Path, "."))
      If MiExt Like "*xls*" Then
      .Cells(j, 1).Select
      .Hyperlinks.Add Anchor:=Selection, Address:=file.Path, TextToDisplay:=file.Path
      j = j + 1
      End If
      Next
      End With
      End Function

      Saludos

        1. Hola , y para que muestra en la columna B la fecha de creación del archivo o la de ultima modificación , como se agregaría ?

  3. Buenas tardes,
    ¿Y para qué en la columna B aparezca solo el nombre del archivo y su extensión?

    Por otro lado, siempre quiero que me busque en la misma carpeta, ¿De que forma podría hacerlo para que no me salga la ventana de dialogo?

    1. Hola Nuria:

      Así:

      Sub LISTAR_ARCHIVOS()
      'Declaramos variables
      Dim sFSO As Object, Directorio As String
      Dim dir_Archivo As Variant
      'Indicamos ruta a la carpeta
      Directorio = "C:\Users\"
      'Creamos objeto y ejecutamos función Carpeta
      Set sFSO = CreateObject("Scripting.FileSystemObject")
      CARPETA sFSO.GetFolder(Directorio)
      End Sub

      Function CARPETA(ByVal nCarpeta)
      'Declaramos variables
      Dim j As Long, Subcarpeta As Object
      'Con la hoja activa
      With ActiveSheet
      'Iniciamos dos loop, uno que recorre las carpetas
      For Each Subcarpeta In nCarpeta.SubFolders
      CARPETA Subcarpeta
      Next
      j = Application.CountA(.Range("B:B")) + 1
      'y otro que recorre los archivos y los indexa y activa hipervínculo
      For Each File In nCarpeta.Files
      .Cells(j, 2).Select
      .Hyperlinks.Add Anchor:=Selection, Address:=File.Path, TextToDisplay:=File.Path
      j = j + 1
      Next
      End With
      End Function

  4. Hola. Gracias por sus aportes. Estoy buscando realizar este proceso, pero NO quiero que el código liste todos archivos de una carpeta, sino que sólo los archivos que seleccione. Me podrían ayudar con esto?

    Gracias totales.

    1. Hola Leonel:

      Prueba con este código, si he entendido bien, quieres listar solo los archivos que selecciones:

      Sub AGRUPAR_ARCHIVOS()
      'Definimos variables
      Dim i As Long, j As Long
      Dim nArchivo As String, dir_Archivo As Variant
      'Creamos ventana de diálogo para seleccionar los archivos que queremos listar
      dir_Archivo = Application.GetOpenFilename(Title:="SELECCIONA ARCHIVOS PARA CONSOLIDAR", MultiSelect:=True, filefilter:="Excel files (*.xls*), *.xls*")
      'Si no seleccionamos archivos, salimos del proceso
      If Not IsArray(dir_Archivo) Then
      Exit Sub
      End If
      With ActiveSheet
      'Iniciamos un for con para identificar los archivos seleccionados
      If IsArray(dir_Archivo) Then
      For j = LBound(dir_Archivo) To UBound(dir_Archivo)
      i = Application.CountA(Range("A:A")) + 1
      nArchivo = dir_Archivo(j)
      'pasamos el link de cada archivo seleccionado a la hoja
      .Cells(i, 1).Select
      .Hyperlinks.Add Anchor:=Selection, Address:=nArchivo, TextToDisplay:=nArchivo
      Next j
      End If
      End With
      End Sub

    1. Hola Lorena:

      Solo tienes que hacer referencia a la hoja en la que quieres mostrar la información, por ejemplo,

      En lugar de With ActiveSheet, puedes poner With sheets("Hoja1") y mostrará la información en la Hoja1.

      Saludos.

    1. Hola Pepe:

      Puedes hacerlo obteniendo el nombre del archivo y utilizando un condicional:

      If Split(file.Name, ".")(0) >= 500 And Split(file.Name, ".")(0) <= 600 Then

      Saludos.

      1. Hola gracias pòr tu respuesta, pero no te sigo, lo que necesito es que filtre las subcarpetas no los ficheros,
        Caso de que esa linea si sea para subcarpetas en que lugar debería colocarlo? Seria muchas molestia me pegaras el código con la linea en su lugar?
        Gracias de nuevo. Saludos

        1. Hola pepe:

          Disculpa, pensé que te referías a archivos. Mejor, para carpeta es más sencillo todavía:

          La línea del código la debes incluir en la función, el parte del condicional subcarpeta.name

          Espero que ahora haya quedado más claro.

          Function CARPETA(ByVal nCarpeta)
          'Declaramos variables
          Dim j As Long, Subcarpeta As Object
          'Con la hoja activa
          With ActiveSheet
          'Iniciamos dos loop, uno que recorre las carpetas
          For Each Subcarpeta In nCarpeta.SubFolders
          'Si el nombre de la carpeta es entre mayor o igual a 500 y menor o igual a 600 entonces lista sus archivos
          If Subcarpeta.Name >= 500 And Subcarpeta.Name <= 600 Then
          CARPETA Subcarpeta
          End If
          Next
          j = Application.CountA(.Range("A:A")) + 1
          'y otro que recorre los archivos y los indexa y activa hipervínculo
          For Each file In nCarpeta.Files
          .Cells(j, 1).Select
          .Hyperlinks.Add Anchor:=Selection, Address:=file.Path, TextToDisplay:=file.Path
          j = j + 1
          Next
          End With
          End Function

          Saludos!

  5. La verdad un excelente trabajo de este post, pero necesito que solo busque los archivos que están en la raíz carpeta que seleccioné y no en las subcarpetas. Muchas gracias.

    1. Hola Osvaldo: debes sustituir la función por esta otra:

      Function CARPETA(ByVal nCarpeta)
      'Declaramos variables
      Dim j As Long, Subcarpeta As Object
      'Con la hoja activa
      With ActiveSheet
      'Iniciamos dos loop, uno que recorre las carpetas
      j = Application.CountA(.Range("A:A")) + 1
      For Each Subcarpeta In nCarpeta.SubFolders
      .Cells(j, 1) = Subcarpeta.Name
      .Cells(j, 2) = Subcarpeta.DateCreated
      .Cells(j, 2).NumberFormat = "dd/mm/yyyy"
      j = j + 1
      Next
      End With
      End Function

      1. Segu, desde ya muchas gracias por tu pronta respuesta, esta función me lista los nombres de las carpetas que están dentro de la carpeta que selecciono, pero lo que necesito es el nombre de los archivos de la carpeta que selecciono. Muchas gracias, saludos cordiales.

  6. Ok Osvaldo, me alegra que te resulte de utilidad la página.

    Me alegro que lo hayas solucionado : )

    No obstante, para extraer el nombre de los archivos de la carpeta seleccionada, se podría resumir más la macro, pero modificando la función, ya lo tendrías:

    Function CARPETA(ByVal nCarpeta)
    'Declaramos variables
    Dim j As Long, Subcarpeta As Object
    With ActiveSheet
    'Iniciamos dos loop, uno que recorre las carpetas
    j = Application.CountA(.Range("A:A")) + 1
    For Each file In nCarpeta.Files
    .Cells(j, 1) = file.Name
    .Cells(j, 2) = file.DateCreated
    .Cells(j, 2).NumberFormat = "dd/mm/yyyy"
    j = j + 1
    Next
    End With
    End Function

    Saludos!

  7. Hola Cristian:

    Sí, en ejemplo, se ordena en la columna 1, lo puedes ver en este fragmento de código: .Cells(i, 1).Select

    Tendrás que modificarlo según tus necesidades.

    Saludos.

  8. Buenos días Segu, utilizo bastante tu macro ya que resume las necesidad es que tengo cuando quiero listar archivos, sin embargo he tratado de listar archivos de rutas que tienen una longitud de caracteres por celda superior a 256 caracteres y la macro se me bloquea cuando llega a ese límite, ¿Qué modificación he de hacer en la macro para que me liste rutas de acceso con longitud de caracteres superiores a 256?

    1. Hola Ignacio: Por defecto no se permiten rutas superiores a 256 caracteres. Ahora bien, existen por la red tutoriales que explicar como realizar el cambio si tienes windows 10. Pero estos cambios pueden dañar el sistema operativo, por eso no mostraré ningún enlace hacia estos manuales.

      Siento no poder ayudarte con este asunto, pero es un tema de limitaciones.

      Saludos

  9. Buenas excelente macro, tengo una duda como hago para copiar desde unas subcarpetas archivos que compartan una aprte del nombre ejemplo si hay varios archivos en varias subcarpetas pero todos ellos dentro de su nombre tienen la palabra BOG como hacer una macro que recorra todas las subcarpetas y copie los archivos que contengan esa palabra dentro del nombre de archivo y los pegue en otra carpeta.

    1. Hola si lo que quieres es que contenga esa palabra sería así:

      If UBound(Split(Split(Dir(file), ".")(0), "BOG")) = 1 Then
      .Cells(j, 1).Select
      .Hyperlinks.Add Anchor:=Selection, Address:=file.Path, TextToDisplay:=file.Path
      j = j + 1
      End If

      Solo tienes que introducir un condicional y buscar la palabra en el nombre. OJO, que si es solo la palabra exacta deberías utilizar esto:

      IF InStr(split(dir(file),".")(0), "BOG")=1

      Saludos.

  10. Hola, Segu...!!! Llevaba mucho tiempo buscando una macro que realizar esto. Muchas gracias por compartir tu trabajo. Me vino muy bien.
    Descargué tu libro y funciona de maravillas en la mayoría de los casos. No obstante, presenta problemas cuando intento realizar la búsqueda en la raíz de la unidad C ó D; es decir C:\ ó D:\. Me devuelve un error y me señala que está en la línea que dice "For Each Subcarpeta In nCarpeta.SubFolders".

    1. Hola Mauricio:

      es que la macro es para buscar en carpetas o subcarpetas, las unidades C, D ... son unidades que contienen carpetas. La macro es para el uso de carpetas no funciona para lo que intentas hacer. Saludos

      1. Hola Segu...!!! Gracias por tomarte la molestia de responderme.
        ¿Y se puede adaptar el código para que tome las búsquedas desde la raíz de cada unidad, es decir sin especificar una carpeta?

Si te ha gustado o tienes alguna duda, puedes dejar aquí tu comentario.

Este sitio web utiliza cookies para que usted tenga la mejor experiencia de usuario. Si continúa navegando está dando su consentimiento para la aceptación de las mencionadas cookies y la aceptación de nuestra política de cookies, pinche el enlace para mayor información.plugin cookies

ACEPTAR
Aviso de cookies