Copia muchos archivos a variadas carpetas según el nombre del archivo a copia y carpeta destino
Tengo una carpeta con mas de 5000 archivo y su nombre comienza con dígitos
Las carpetas que deben contener estos archivos también comienzan con los mismos dígitos
Y se encuentran en un disco de red.
Ejemplo de archivo: 3415-monitor.pdf
Carpeta donde se debe copiar:
3415-monitor
Las carpetas ya están creadas
Lo ideal seria con una macro. No se como realizarlo
1 respuesta
Tengo las siguientes dudas:
¿Todos los archivos inician con 4 dígitos?
Las carpetas deben iniciar con 4 dígitos, en tu ejemplo pusiste “carpeta donde se debe copiar: 3415-monitor”, ¿pero esto significa que habrá una carpeta por archivo?, o en una carpeta 3415, ¿se van a copiar todos los archivos que empiecen con 3415?
Si en un carpeta 3415, se van a copiar todos los archivos entonces realiza las instrucciones anexas.
Instrucciones
1. Abre una hoja de excel y guárdala con el nombre copiaarchivos
2. Para abrir Vba-macros y poder pegar la macro, Presiona ALt + F11
3. En el menú elige Insertar / Módulo
4. En el panel del lado derecho copia la macro
5. En la macro hay un dato que se llama carpetaorigen, aquí tienes que poner el directorio en donde se encuentran los archivos
6. También tienes que cambiar la carpetadestino por la carpeta donde inician los directorios con dígitos.
7. Para ejecutarla presiona F5
Notas:
En el archivo de Excel llamado copiaarchivos, te va a poner en la columna A, la Lista de los archivos. En la columna B, te va a poner si se copió el archivo o tuvo error al momento de realizar la copia, el problema principal, es que no encuentre la carpeta destino.
'*******Macro****** Sub listar_archivos() 'Por.Dam 'Lee archivos de un directorio y los copia en un destino On Error Resume Next carpetaorigen = "C:\Documents and Settings\DAMOR\Mis documentos\docs\Soporte expertos\archivos\" carpetadestino = "C:\Documents and Settings\DAMOR\Mis documentos\docs\Soporte expertos\archivos\" Set navegador = CreateObject("shell.application") ChDir carpetaorigen archi = Dir("*.*") Workbooks("copiaarchivos").Activate Range("A:B").Clear Range("A1").Select Do While archi <> "" ActiveCell.Value = archi ActiveCell.Offset(1, 0).Select ActiveCell.Value = celda archi = Dir() Loop Dim archori, archdes As String ufila = Range("A" & Rows.Count).End(xlUp).Row Range("A1").Select lin = 1 Do While lin <= ufila archori = carpetaorigen & Cells(lin, 1).Value numcarpeta = Left(Cells(lin, 1).Value, 4) archdes = carpetadestino & numcarpeta & "\" & Cells(lin, 1).Value FileCopy archori, archdes If Err.Number = 0 Then 'El archivo fue copiado Cells(lin, 2).Value = ("Copiado") Else Cells(lin, 2).Value = ("Copia con Error " & Err.Number) Err.Number = 0 End If lin = lin + 1 Loop End Sub '******Macro*******
Saludos.Dam
No olvides cerrar la pregunta
Gracias por tu respuesta.
Aclaro algunos puntos: comienzan con 4 y algunos con 5 dígitos, pero no se repiten y las carpetas de la misma forma es decir 4 y 5 dígitos es decir un correlativo, exite un solo numero 3415 tanto en la carpeta como en los archivos
al final de los números tiene un guion y el nombre de equipo que son distintos.
La carpeta de origen esta c:\pendientes
La carpeta de destino esta en disco de red k:\\transfer\equipos
y dentro de equipos están las 5000 carpetas distintas.
espero que no sea muy complejo, y nuevamente muchas gracias por tu pronta respuesta.
1. No me queda clara la relación entre el archivo y la carpeta, me podrías poner varios ejemplos reales de 5 archivos de 4 dígitos y a cuál o cuáles carpetas deben ir, y otros 5 ejemplos de archivos de 5 dígitos y a cuál o cuáles carpetas deben ir, y si puedes poner más ejemplos, mejor, tienes como 5,000 ejemplos.
2. En cuanto a las carpetas origen y destino te actualizo el nombre en el código de la macro.
3. Actualmente puedes copiar un archivo desde la carpeta c:\pendientes a la carpeta k:\\transfer\equipos, desde windows.
Buenos días
en Carpeta C:\pendientes tengo los siguientes ejemplos
3415-monitor- marca xxx
3416-maquina de anestesia- marca yyyy
4018- mesa quirúrgica- marca zzzz
17185-columna de gases- marca AAAAA
24132- equipos de rayos-marcaHHHHH
copiar a la carpetas que corresponda
k:\\transfer\equipos\3415-monitor
k:\\transfer\equipos\3416-maquina de anestesia
k:\\transfer\equipos\4018- mesa quirúrgica
k:\\transfer\equipos\17185-columna de gases
k:\\transfer\equipos\24132- equipos de rayos
Como se observa las carpetas tiene la correspondencia con los archivos en los números.
Realiza las instrucciones que te envié anteriormente y copia la siguiente macro.
'*******Macro****** Sub listar_archivos() 'Por.Dam 'Lee archivos de un directorio y los copia en un destino On Error Resume Next carpetaorigen = "C:\Pendientes\" carpetadestino = "k:\\transfer\equipos\" Set navegador = CreateObject("shell.application") ChDir carpetaorigen archi = Dir("*.*") Workbooks("copiaarchivos").Activate Range("A:D").Clear Range("A1").Select Do While archi <> "" ActiveCell.Value = archi ActiveCell.Offset(1, 0).Select ActiveCell.Value = celda archi = Dir() Loop Dim archori, archdes As String ufila = Range("A" & Rows.Count).End(xlUp).Row Range("A1").Select lin = 1 Do While lin <= ufila archori = carpetaorigen & Cells(lin, 1).Value celda = Cells(lin, 1).Value caracter = InStr(7, celda, "-") numcarpeta = Left(Cells(lin, 1).Value, caracter - 1) archdes = carpetadestino & numcarpeta & "\" & Cells(lin, 1).Value FileCopy archori, archdes If Err.Number = 0 Then 'El archivo fue copiado Cells(lin, 2).Value = ("Copiado") Else Cells(lin, 2).Value = ("Copia con Error " & Err.Number) Err.Number = 0 Cells(lin, 3).Value = archori Cells(lin, 4).Value = archdes End If lin = lin + 1 Loop End Sub '******Macro*******
En el archivo de excel te deja esto:
A B C D
Archivo a copiar Copiado o Error archivo origen archivo destino
Saludos. DaM
No olvides cerrar la pregunta
Hola
Probé la macro , tuve que modificar el camino (estoy en mi casa), pero copia los archivos
en el directorio equipos.
en el archivo excel me indica:
3415 - MONITOR.pdf
Copia con Error 5
C:\Pendientes\3415 - MONITOR.pdf
C:\transfer\equipos\\3415 - MONITOR.pdf
3416 - maquina de anestesia.pdf
Copia con Error 5
C:\Pendientes\3416 - maquina de anestesia.pdf
C:\transfer\equipos\\3416 - maquina de anestesia.pdf
No se que puede faltar
Lo que sucede, es que me habías dicho que los archivos eran similares a este:
3416-maquina de anestesia- marca yyyy
La macro necesita que el nombre de archivo tenga 2 guiones, en el ejemplo, "anestesia-marca", el guión entre anestesia y marca, me ayuda para identificar el nombre del directorio completo: que sería : 3416-maquina de anestesia.
Tu archivo ejemplo “3416 - maquina de anestesia.pdf”, no trae el segundo guión, no se puede identificar el nombre completo del directorio.
Entiendo que necesitas que con el puro número “3416” busque la carpeta “3416 - maquina de anestesia”.
Confírmame si los archivos pueden venir o no con el segundo guión, para revisar otra opción.
Saludos. DaM
3416-maquina de
anestesia marca yyyy-.pdf
Copia con Error 76
C:\Pendientes\3416-maquina de anestesia
marca yyyy-.pdf
E:\transfer\equipos\3416-maquina de
anestesia marca yyyy\3416-maquina de anestesia marca yyyy-.pdf
3417-maquina de anestesia marca yyyy-.pdf
Copia con Error 76
C:\Pendientes\3417-maquina de anestesia marca yyyy-.pdf
E:\transfer\equipos\3417-maquina de anestesia marca yyyy\3417-maquina de
anestesia marca yyyy-.pdf
Le puse guión entre el numero y final.
pero no copia
Pero tienes que poner el guión así:
3417-maquina de anestesia-marca yyyy.pdf
3416-maquina de anestesia-marca yyyy.pdf
El segundo guión va como en los ejemplos que me enviaste:
3415-monitor- marca xxx
3416-maquina de anestesia- marca yyyy
4018- mesa quirúrgica- marca zzzz
17185-columna de gases- marca AAAAA
24132- equipos de rayos-marcaHHHHH
Copiar a la carpetas que corresponda
k:\\transfer\equipos\3415-monitor
k:\\transfer\equipos\3416-maquina de anestesia
k:\\transfer\equipos\4018- mesa quirúrgica
k:\\transfer\equipos\17185-columna de gases
k:\\transfer\equipos\24132- equipos de rayos
Sigo trabajando en la macro para hacer la copia con tan solo el número, ¿pero necesito que me confirmes si después del número va un guión?
También dime si puede haber un archivo 2222-monitor y otro archivo así 2222-accesorio, tenemos dos archivos que tienen el mismo número pero después del guión el nombre cambia.
hola
daM
probé lo que indicaste, pero no resulta
3416-maquina de
anestesia- marca yyyy.pdf
Copia con Error 76
C:\Pendientes\3416-maquina de anestesia-
marca yyyy.pdf
E:\transfer\equipos\3416-maquina de
anestesia\3416-maquina de anestesia- marca yyyy.pdf
respecto a las preguntas: Siempre va un guion tanto en la carpeta como en los archivos
respeto a los archivos los números son como la identificación personal,es único, pero si a futuro existirán otros archivos
Ejemplo:
al inicio de la carpeta tenemos el equipo, en este caso 3416-maquina de anestesia-marc xxx
a futuro tendremos 3416-informe reparación 30_09_12 ó 3416-mantención preventiva 05_10_12.
por lo tanto después del guion cambia.
Gracias
Pero La búsqueda de la carpeta es correcta:
C:\Pendientes\3416-maquina de anestesia- marca yyyy.pdf
E:\transfer\equipos\3416-maquina de anestesia\3416-maquina de anestesia- marca yyyy.pdf
Tienes que crear la carpeta E:\transfer\equipos\3416-maquina de anestesia
Por favor, revisa que exista la carpeta y vuelve a ejecutarla.
Si siguen con la regla: número – carpeta – archivo, no debes tener problema con está macro en el futuro.
Saludos. DaM
Por favor, si no tienes problemas, puedes cerrar la pregunta
Ejecuta esta macro, ya le hice cambios para que no necesite el “segundo guión”.
Revisa los nombres de la carpetaorigen y de la carpetadestino
'*******Macro****** Sub listar_archivos() 'Por.Dam 'Lee archivos de un directorio y los copia en un destino On Error Resume Next Dim archori, archdes As String carpetaorigen = "C:\Pendientes\" carpetadestino = "E:\transfer\equipos\" 'lee archivos del origen Set navegador = CreateObject("shell.application") ChDir carpetaorigen archi = Dir("*.*") Workbooks("copiaarchivos").Activate Range("A:E").Clear Range("A1").Select Do While archi <> "" ActiveCell.Value = archi ActiveCell.Offset(1, 0).Select archi = Dir() Loop 'lee las carpetas destino Set navegador = CreateObject("shell.application") ChDir carpetadestino carpe = Dir("*", vbDirectory) Range("B1").Select Do While carpe <> "" ActiveCell.Value = carpe ActiveCell.Offset(1, 0).Select carpe = Dir() Loop ufila = Range("A" & Rows.Count).End(xlUp).Row ufilacarpetas = Range("B" & Rows.Count).End(xlUp).Row Range("A1").Select lin = 1 Do While lin <= ufila archori = carpetaorigen & Cells(lin, 1).Value celda = Cells(lin, 1).Value escuatro = InStr(1, celda, "-") If escuatro = 5 Then numarchivo = Left(Cells(lin, 1).Value, 4) Else If escuatro = 6 Then numarchivo = Left(Cells(lin, 1).Value, 5) End If End If 'busca numero archivo en el numero de carpeta lincarpetas = 1 nomcarpeta = "" Do While lincarpetas <= ufilacarpetas If escuatro = 5 Then nummasguion = numarchivo & "-" If nummasguion = Left(Cells(lincarpetas, 2).Value, 5) Then nomcarpeta = Cells(lincarpetas, 2).Value Exit Do End If Else If escuatro = 6 Then 'numarchivo = Left(Cells(lin, 1).Value, 5) nummasguion = numarchivo & "-" If nummasguion = Left(Cells(lincarpetas, 2).Value, 6) Then nomcarpeta = Cells(lincarpetas, 2).Value Exit Do End If End If End If lincarpetas = lincarpetas + 1 nomcarpeta = "" Loop If nomcarpeta = "" Then 'La carpeta destino no existe Cells(lin, 3).Value = ("La carpeta destino no existe") Cells(lin, 4).Value = archori Cells(lin, 5).Value = archdes Else archdes = carpetadestino & nomcarpeta & "\" & Cells(lin, 1).Value FileCopy archori, archdes If Err.Number = 0 Then 'El archivo fue copiado Cells(lin, 3).Value = ("Copiado") Else Cells(lin, 3).Value = ("Copia con Error " & Err.Number) Err.Number = 0 Cells(lin, 4).Value = archori Cells(lin, 5).Value = archdes End If End If lin = lin + 1 Loop End Sub '******Macro*******
Saludos.dam
No olvides cerrar la pregunta
- Compartir respuesta
Hola estuve probando este macro para un problema similar pero necitaria que lea hasta ocho caracteres numéricos antes del guion - saino