Macro para buscar archivos de excel
Busco una macro que me permita recorrer todas las carpetas de un directorio que yo elija y me copie todos los archivos *.xls* a una carpeta destino. El nombre del directorio cambiaría, pero el de la carpeta de destino podría ser el mismo.
Nota: esta pregunta la formulé hace unos días, pero tan mal explicada que ni yo mismo la entiendo, y es por eso que la formulo de nuevo. Si estoy incumpliendo alguna norma de la web, entendería que no fuera publicada.
1 Respuesta
Respuesta de Dante Amor
1
H o l a:
Te anexo la macro.
Dim rutas As New Collection Sub CopiarArchivosXls() 'Por.Dante Amor 'Copia archivos a una carpeta destino ' Application.ScreenUpdating = False Application.DisplayAlerts = False rutadestino = "C:\trabajo\cartas\" ruta = "C:\" ext = "xls*" ' With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Selecciona una carpeta" .AllowMultiSelect = False .InitialFileName = ruta If .Show <> -1 Then Exit Sub carpeta = .SelectedItems(1) End With ' If carpeta = "" Then Exit Sub ' pPath = carpeta & "\" rutas.Add carpeta Call agregadir(pPath) ' For Each sd In rutas arch = Dir(sd & "\*." & ext) Do While arch <> "" FileCopy sd & "\" & arch, rutadestino & arch arch = Dir() Loop Next ' Set rutas = Nothing MsgBox "Fin, copiar archivos xls", vbInformation, "ARCHIVOS" End Sub ' Sub agregadir(lpath) 'Agrega directorios 'Por.Dante Amor 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
Indicaciones:
- En esta línea de la macro pon la carpeta destino:
rutadestino = "C:\trabajo\cartas\"
- Copia todo el código en un módulo.
- La macro que debes ejecutar es la que tiene el nombre "CopiarArchivosXls"
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
