Macro para buscar archivos txt en múltiples carpetas desde archivo excel
Tengo una buena consulta, resulta que ocupo un macro que me permita buscar desde una lista en excel, todos los archivos en .txt que coincidan y me los copie a otra carpeta destino, buscando y buscando logré conseguir el siguiente macro:
Sub ejemplo()
sheets("hoja1").select
Range("a1").Select
On Error Resume Next
Do While ActiveCell.Value <> ""
inicio = "C:\TXT-Buenos Aires\" & ActiveCell.Value & ".txt"
fin = "C:\TXT\" & ActiveCell.Value & ".txt"
FileCopy inicio, fin
ActiveCell.Offset(1, 0).Select
Loop
End Sub
'antes de correr el macro se debe seleccionar la columna donde se va a hacer la búsqueda
Resulta que si yo lo buscara de una carpeta específica, este macro me sirve de mil maravillas, pero ahora ocupo que no solo recorra una carpeta sino múltiples carpetas, es decir, que me recorra en una carpeta raíz que a su vez contiene múltiples carpetas, me busque los archivos .txt que coinciden con la lista
El formato del nombre de archivo es siempre numérico, ejemplo: 123456789.txt y en la lista está como 123456789
1 Respuesta
Esta sería la macro.
Nota: Al inicio de toda la macro debe ir declarada la variable rutas, es una variable global que se ocupa en las 2 rutinas que te estoy enviando, entonces revisa que quede al principio de tu módulo.
Solamente actualiza las carpetas para inicio y para fin, la macro toma la carpeta inicio para recorrer todas las subcarpetas.
Dim rutas As New Collection
Sub ejemplo()
'Mod.Por.DAM
Sheets("hoja1").Select
Range("a1").Select
On Error Resume Next
inicio = "C:\TXT-Buenos Aires" 'sin la última diagonal
fin = "C:\TXT"" 'sin la última diagonal"
rutas.Add inicio
Call agregadir(inicio & "\")
Do While ActiveCell.Value <> ""
archo = ActiveCell.Value & ".txt"
finx = fin & "\" & ActiveCell.Value & ".txt"
For Each sd In rutas
arch = Dir(sd & "\*.txt")
Do While arch <> ""
If arch = archo Then
FileCopy sd & "\" & arch, finx
DoEvents
Exit For
End If
arch = Dir
Loop
Next
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Sub agregadir(lpath)
'Por.DAM
'Agrega directorios
Dim SubDir As New Collection
If Right(lpath, 1) <> "\" Then lpath = lpath & "\"
DirFile = Dir(lpath & "*", vbDirectory)
Do While DirFile <> ""
'Agrega subdirectorios a collection
If DirFile <> "." And DirFile <> ".." Then _
If ((GetAttr(lpath & DirFile) And vbDirectory) = 16) Then _
SubDir.Add lpath & DirFile
DirFile = Dir
Loop
For Each sd In SubDir
rutas.Add sd
Call agregadir(sd)
Next
End Sub Saludos. Dante Amor
No olvides finalizar la pregunta.
Hola que tal Vero Arce tengo más o menos el mismo problema que tu necesito hacer la búsqueda de archivos que se encuentran en una carpeta y cambiarlos a otra pero mis archivos son excel y necesito cambiarlos a pdf tu código me parece bien pero ya modifique según mis rutas y no me copia los archivos.Tendrás una macro como la que te digo - francisco gutierrez