Copiar archivos de una carpeta a otra con macro

Espero que me explique bien, y gracias por su ayuda:

Ya tengo este código de macro, el cual copia todos los archivos que están en la carpeta

Creación a la carpeta artistas:

Dim fso As New FileSystemObject
fso.CopyFolder "C:\USERDATA\Eduardo\creacion", "C:\USERDATA\Eduardo\artistas"
MsgBox "Se copiaron satisfactoriamente los artistas C:\USERDATA\Eduardo\artistas"

Lo que quiero hacer es que si el archivo ya está en la carpeta de artistas que no lo copie y que lo descarte o lo borre.

Por ejemplo: el archivo "a.xlsx" esta en la carpeta de creación y al momento de querer pasarla a artistas y si ya esta, que no lo copie, pero si no esta que siga copiandose los archivos.

No necesariamente tiene que ser el mismo nombre del ejemplo, este puede variar "b.xlsx", "c.xlsx" y así... Ahora sí que puede tener el nombre que sea, pero si no esta se copia y si esta no lo hace.

2 respuestas

Respuesta
2

Pero tendría que ser con otra instrucción, quizás una que copie archivo por archivo y que antes de copiar verifique si existe para ya no copiarlo, si quieres te envío una nueva macro pero tendría que ser con estas características

Perfecto, estaría mucho mejor.

Si, por favor

Saludos

Me parece que no necesitamos otra macro, prueba con lo siguiente

Dim fso As New FileSystemObject
fso.CopyFolder "C:\USERDATA\Eduardo\creacion", "C:\USERDATA\Eduardo\artistas", False
MsgBox "Se copiaron satisfactoriamente los artistas C:\USERDATA

Por default, el último parámetro (overwrite), es True, sobreescribir, para que no sobreescriba, se debe poner el parámetro False

Prueba y me comentas

Saludos. Dam
Si es lo que necesitas.

Me marca un error

fso.CopyFolder "C:\USERDATA\Eduardo\creación", "C:\USERDATA\Eduardo\artistas", False

Y está igual

En lugar de False, escribe 0:

fso.CopyFolder "C:\USERDATA\Eduardo\creación", "C:\USERDATA\Eduardo\artistas", 0

Ya lo hice y tampoco, no me esta aceptando false, porque escribí true y si dio...

Revisaste la carpeta origen

La palabra creacion debe ir sin acento

Prueba otra vez, y si no hay resultado, creo la macro para copiar archivo por archivo

Saludos. Dam

Te envío la macro que copia los archivos de una carpeta a otra y no sobreescribe los archivos que ya existan

Sub copiaarch()
'copia archivos
'por.dam
co = "C:\USERDATA\Eduardo\creacion\"
cd = "C:\USERDATA\Eduardo\artistas\"
'lee archivos del origen
ChDir co
archi = Dir("*.*")
Do While archi <> ""
    With Application.FileSearch
        .NewSearch
        .LookIn = cd
        .FileType = msoFileTypeAllFiles 'msoFileTypeAllFiles
        .Filename = archi
        .MatchTextExactly = True
        '.SearchSubFolders = True ' para buscar en sub carpetas
        ' ejecuta la búsqueda
        If .Execute > 0 Then
            'si lo encontró entonces no lo copia
        Else
            'no está se copia
            FileCopy co & archi, cd & archi
            If Err.Number <> 0 Then
                MsgBox "no se copio " & archi
            End If
            Err.Number = 0
        End If
    End With
    archi = Dir()
Loop
End Sub

Saludos.Dam
Si es lo que necesitas.

si verifique que no tuviera acento.

ya intente usar el código y me marca error simplemente ejecutando ChDir

De verdad gracias por la ayuda

Lo siento el error es del with y no se por que, ya le estuve buscando

Es por la versión, ¿tienes 2007 ó 2010?

Tengo que enviarte un código para buscar archivos para tu versión.

Corrijo la macro y te la envío

Me dices qué versión de excel tienes

Saludos. Dam

es 2010

Gracias

Saludos

Cambian mucho las instrucciones?

Saludos

GRacias

Si cambian las instrucciones pero creo que es más sencillo

Esta es la macro

Sub buscaarchivos2007()
'Por.dam
Dim archivos As New Collection
co = "C:\trabajo\USERDATA\Eduardo\creacion\"
cd = "C:\trabajo\USERDATA\Eduardo\artistas\"
ChDir co
archivo = Dir("*.*")
Do While archivo <> ""
    archivos.Add (archivo)
    archivo = Dir()
Loop
For Each archi In archivos
    DirFile = Dir(cd & archi)
    If DirFile = "" Then
        FileCopy co & archi, cd & archi
    End If
Next
End Sub

Saludos.Dam
Si es lo que necesitas.

Respuesta
1

Encontré una macro pero quisiera que me ayuden a hacer algunos cambios sobre esta macro,

1ero. Esta macro copia los archivos que están en la celda A1 en la ubicación donde se encuentra la macro. (Lo que quisiera es de que en una celda poder ponder la ubicación de origen y la ubicaion de destino donde copiar)

2do Al carle clic en copiar esta me pide que ingrese el tipo de extensión. (Lo que quiero es de que yo pueda ingresar la extensión en una celda)

3ero. La macro al no encontrar un archivo se paraliza el proceso (lo que quiero es de que siga el proceso y me indicque cual no existen ya sea pintándolo de rojo o al costado una nota que diga "no existe archivo" o algo similar para saber que archivo no se llego a copiar.

Les adjunto una imagen de como podría quedar lo mencionado.

Les agradezco de antemano a todos los que me puedan ayudar, mil gracias,

Les dejo mi correo para una comunicación más directa: [email protected]

Esta es la macro de lo mencionado:

Sub Copy_files()

Dim Archivo, SubCarpeta, carpeta, archivos, extension, file_origen, file_destino As String
Dim contador As Integer
'Lectura de carpeta y ajustes necesarios
extension = InputBox("Ingrese la extensión, INCLUYENDO EL PUNTO")
carpeta = InputBox("Ingresa la ruta de la carpeta donde buscar:")
If carpeta = "" Then
Exit Sub
ElseIf Right(carpeta, 1) <> "\" Then
carpeta = carpeta & "\"
End If
'Preparación de variables
contador = 1
archivos = Dir(carpeta & "*.*")
'Recorrido del archivo
Do While Len(archivos) > 0
archivos = ActiveSheet.Cells(contador, 1).Value & extension
fn = Dir(archivos & extension)
contador = contador + 1
file_origen = carpeta & archivos
file_destino = ActiveWorkbook.Path & "\" & archivos
On Error GoTo 1
FileCopy file_origen, file_destino
'On Error Resume Next
'On Error GoTo 0

1 On Error GoTo 0
Loop
'1

End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas