Listar y copiar archivos desde carpetas y subcarpetas
Estimado Angel como estás; por favor preciso lo siguiente
En una hoja preciso listar todos los archivos desde CARPETAS Y SUBCARPETAS de una ruta Origen.
Así mismo todos estos archivos de Carpetas y Subcarpetas, los preciso copiar a otra Ruta Destino.
Mil gracias
Abrazo
Hugo
1 respuesta
Entiendo que esta consulta está dirigida a alguien en especial llamado Angel... pero como no veo a nadie llamado así en esta categoría, y a eso sumado a que el sitio no estuvo enviando notificaciones desde hace tiempo ya, me tomo el atrevimiento de _adelantarte_ una respuesta a la primer parte de tu consulta, hasta tanto recibas la ayuda solicitada.
En un libro Excel, tendrás que indicar tu ruta de origen en alguna celda, en mi ejemplo E1, como se observa en la siguiente imagen.
Entrando al Editor de macros (con ALT+F11 o desde la ficha Programador/Desarrollador), debes insertar un módulo y allí copiar la macro que te adjunto.
Sub listarSubcarpetas()
'x Elsamatilde
Dim fs As Object, origen As Object, carpeta As Object, subcarpeta As Object, subcarpe As Object
Dim ruta As String, ruta2 As String, filx As Long
Set fs = CreateObject("Scripting.FileSystemObject")
'la ruta de la carpeta principal se obtiene de la celda E1 (SIN BARRAS)
ruta = [E1]
'fila donde empezará la lista de carpetas obtenidas
filx = 2
'si la celda está vacía cancela
If ruta = "" Then Exit Sub
'contempla posible error de ruta no hallada
On Error GoTo sinRuta
Set origen = fs.GetFolder(ruta)
'se buscan las carpetas de la ruta solicitada
For Each carpeta In origen.subfolders
Range("A" & filx) = carpeta.Name
filx = filx + 1
'x cada carpeta se listan las subcarpetas
ruta2 = carpeta.Path
Set subcarpeta = fs.GetFolder(ruta2)
For Each subcarpe In subcarpeta.subfolders
Range("B" & filx) = subcarpe.Name
filx = filx + 1
Next
Next
Exit Sub
sinRuta:
[E2] = "No se encontró la ruta indicada en celda E1."
End SubEl resultado será como el que se observa en la primera imagen.
Espero haber contribuido a la resolución de parte de tu consulta y pido disculpas por la intromisión ;)
