MACRO para que cree carpetas
Publicado por LFJ (1 intervención) el 12/09/2017 19:10:33
Saludos comunidad.
Tengo un base de archivos muy grande que contiene varias subcarpetas, necesito hacer una MACRO para que lea la dirección de origen y cree carpetas en otra dirección destino, no siempre son las mismas así que sería más fácil que las leyera desde una celda, ya estableciendo el origen y el destino desde celdas que se puedan modificar, necesito que no copie todo lo que hay en esa carpeta o es sus subcarpetas sin que busque una lista de archivos con varias extensiones y de todos ellos cree una copia en una carpeta diferente dependiendo el archivo y finalmente, si es posible, que muestre un aviso de que archivos no se copiaron o cuales no existen.
Por ejemplo:
Teniendo una celda donde pueda pegar la ruta de origen y otra la ruta de destino poner:
Origen: X:\Fosa
Destino: Y:\Clasificados
Y en una columna poner los archivos a mover y en otra la carpeta donde va a crear la copia, y poner un indicador de éxito en otra columna, no se un color o algo:
Nombre | Carpeta | Indicador
AQWERTY.pdf | AQWERTY |
AQWERTY.jpg | AQWERTY |
AQWERTY.mp4 | AQWERTY |
BQWERTY.jpg | BQWERTY |
BQWERTY.xlsx | BQWERTY |
BQWERTY.gpx | BQWERTY |
Apenas estoy aprendiendo a programar en excel y no tengo ni idea de como hacerlo, espero me puedan ayudar y de ante mano les agradezco su atencion.
El macro que estoy utilizando lo pondré debajo, lo que hace ese macro es buscar una lista de archivos en una carpeta para moverlos a otra, los renombra y crea ficheros dependiendo del archivo, se puede cambiar las carpetas de origen y destino de manera manual y de igual forma las carpetas donde va a mover cada archivo, pero borra los archivos de la ruta de origen y no necesito renombrar ninguno de la lista.
Tengo un base de archivos muy grande que contiene varias subcarpetas, necesito hacer una MACRO para que lea la dirección de origen y cree carpetas en otra dirección destino, no siempre son las mismas así que sería más fácil que las leyera desde una celda, ya estableciendo el origen y el destino desde celdas que se puedan modificar, necesito que no copie todo lo que hay en esa carpeta o es sus subcarpetas sin que busque una lista de archivos con varias extensiones y de todos ellos cree una copia en una carpeta diferente dependiendo el archivo y finalmente, si es posible, que muestre un aviso de que archivos no se copiaron o cuales no existen.
Por ejemplo:
Teniendo una celda donde pueda pegar la ruta de origen y otra la ruta de destino poner:
Origen: X:\Fosa
Destino: Y:\Clasificados
Y en una columna poner los archivos a mover y en otra la carpeta donde va a crear la copia, y poner un indicador de éxito en otra columna, no se un color o algo:
Nombre | Carpeta | Indicador
AQWERTY.pdf | AQWERTY |
AQWERTY.jpg | AQWERTY |
AQWERTY.mp4 | AQWERTY |
BQWERTY.jpg | BQWERTY |
BQWERTY.xlsx | BQWERTY |
BQWERTY.gpx | BQWERTY |
Apenas estoy aprendiendo a programar en excel y no tengo ni idea de como hacerlo, espero me puedan ayudar y de ante mano les agradezco su atencion.
El macro que estoy utilizando lo pondré debajo, lo que hace ese macro es buscar una lista de archivos en una carpeta para moverlos a otra, los renombra y crea ficheros dependiendo del archivo, se puede cambiar las carpetas de origen y destino de manera manual y de igual forma las carpetas donde va a mover cada archivo, pero borra los archivos de la ruta de origen y no necesito renombrar ninguno de la lista.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub CambiarNombreSinRuta()
'Antes de correr la macro, elije las celdas que tengan la ruta
'del nombre actual, es decir a partir de A2
Dim NombreNuevo As String
Dim NombreAnterior As String
Dim NombreCarpeta As String
'Si no encuentra algún archivo, continuará con el siguiente
On Error Resume Next
For Each Celda In Selection
NombreAnterior = Celda.Value
'El dato del nombre nuevo será la columna D, especificado con 3
NombreNuevo = Celda.Offset(0, 1).Value
'Valido si existe la carpeta
NombreCarpeta = Celda.Offset(0, 2).Value
x = Dir(Range("k2").Value & NombreCarpeta, vbDirectory)
If x = "" Then
'MsgBox ("La carpeta" & NombreCarpeta & "no existe")
MkDir (Range("k2").Value & NombreCarpeta)
Else
'MsgBox ("La carpeta" & NombreCarpeta & "existe")
End If
Name Range("j2").Value & NombreAnterior As Range("k2").Value & NombreCarpeta & "\" & NombreNuevo
Next Celda
MsgBox "Tus archivos fueron acomodados en sus respectivas carpetas "On Error GoTo 0
End Sub
Valora esta pregunta
0