Saltar al contenido

Recommended Posts

¡Hola!

Estoy trabajando con un macro que copie toda una carpeta con subcarpetas y archivos a otra ubicación, el nombre de las carpetas estan en A1, la ruta donde las voy a mover en B1.

Por ahora tengo esto pero no logro que funcione.

 

Sub copiafolder()
Dim FSO As Object
    Dim inicio As String
    Dim fin As String
    Dim valida As String

    Set FSO = CreateObject("scripting.filesystemobject")


Range("A1").Select
On Error Resume Next
Do While ActiveCell.Value <> ""
    inicio = Range("B1") & ActiveCell
    fin = Range("B1")
    valida = Dir(inicio)
    If valida = "" Then
        Else
        FSO.CopyFolder inicio, fin
        End If
    ActiveCell.Offset(1, 0).Select
Loop

End Sub


 

Como dato adicional, por ahora las carpetas están en mi escritorio, pero pienso cambiarla por una formula que completa la ruta donde se encuentran.

Por ejemplo:
En A1 estaria "X:\documentos\car1"
En B1 esaria la ruta donde deben pegarse las carpetas "D:\contenedor"

carpetas.xlsm

Compartir este mensaje


Enlace a mensaje
Compartir con otras webs

Hola

En el supuesto que tu celda A1 contenga "X:\documentos\car1" y B1 contenga "D:\contenedor"", tu variable inicio quedaría así:

"D:\contenedorX:\documentos\car1"

Si queda como en tu archivo, en A1 solo diga "car1", y en B1 "C:\Users\Microformas\Desktop\destino",  tu variable inicio quedaría como:

"C:\Users\Microformas\Desktop\destinocar1"

¿Notas el error en ambos casos? 

Abraham Valencia

 

Editado el por avalencia

Compartir este mensaje


Enlace a mensaje
Compartir con otras webs
Ahora mismo, avalencia dijo:

Hola

En el supuesto que tu celda A1 contenga "X:\documentos\car1" y B1 contenga ""X:\documentos\car1"", tu variable inicio quedaría así:

"X:\documentos\car1X:\documentos\car1"

Si queda como en tu archivo, en A1 solo diga "car1", y en B1 "C:\Users\Microformas\Desktop\destino",  tu variable inicio quedaría como:

"C:\Users\Microformas\Desktop\destinocar1"

¿Notas el error en ambos casos? 

Abraham Valencia

 

¡SI!, el ultimo de tus ejemplos es como lo estoy trabajando ahora, pero se me hace raro que en el caso donde en A1 tengo "car1" y en B1  "C:\Users\Microformas\Desktop\destino"

Corrijo con esto ¿no?

inicio = Range("B1") & "\" & ActiveCell

Pero aun así no funciona.

 

Y en el primer ejemplo es como me gustaria trabajar el macro, pero seria solo ajustarlo. Por ahora no logro que copie nada.

Compartir este mensaje


Enlace a mensaje
Compartir con otras webs

Solo una correccion en tu codigo te digo por que a mi me dio Muelas llegar a esto espero te ayude

Origen =  "c:\DirectorioOrigen\*.*"  ' yo no se por que a mi me pedia que especifique el  *.*

destino =  "c:\DirectorioDestino\"  ' y en el destino tenga al final la barra invertida o antislash "\" 

fso.CopyFolder origen ,destino ,1 ' el uno para que sobreescriba 

 

Espero te ayude

Compartir este mensaje


Enlace a mensaje
Compartir con otras webs
Do While ActiveCell.Value <> ""
    inicio = Range("B1") & ActiveCell
    fin = Range("B1")
    valida = Dir(inicio)
     msgbox inicio  &  " - " & fin  ' estas seguro que existe esa ruta ??? presentala para ver si te vale
    If valida = "" Then  
        Else
        FSO.CopyFolder inicio, fin
        End If
    ActiveCell.Offset(1, 0).Select
Loop

Compartir este mensaje


Enlace a mensaje
Compartir con otras webs
Ahora mismo, silver_axe007 dijo:

Solo una correccion en tu codigo te digo por que a mi me dio Muelas llegar a esto espero te ayude

Origen =  "c:\DirectorioOrigen\*.*"  ' yo no se por que a mi me pedia que especifique el  *.*

destino =  "c:\DirectorioDestino\"  ' y en el destino tenga al final la barra invertida o antislash "\" 

fso.CopyFolder origen ,destino ,1 ' el uno para que sobreescriba 

 

Espero te ayude

Sub copiafolder()
Dim FSO As Object
    Dim inicio As String
    Dim fin As String
    Dim valida As String

    Set FSO = CreateObject("scripting.filesystemobject")


Range("A1").Select
On Error Resume Next
Do While ActiveCell.Value <> ""
    inicio = Range("B1") & "\" & ActiveCell & "\" & "*.*"
    fin = Range("B1")
    MsgBox inicio & " - " & fin    ' estas seguro que existe esa ruta ??? presentala para ver si te vale
    valida = Dir(inicio)
    If valida = "" Then
        Else
        FSO.CopyFolder inicio, fin, 1
        End If
    ActiveCell.Offset(1, 0).Select
Loop


End Sub

agrege el *.*¨y el slash, la ruta parece estar bien pero no copia nada.


14l3slx.jpg

 

 

 

 

Compartir este mensaje


Enlace a mensaje
Compartir con otras webs

Crear una cuenta o conéctate para comentar

Necesitas ser usuario para poder dejar un comentario

Crear una cuenta

Registrarse para una nueva cuenta en nuestra comunidad. ¡Es fácil!

Registrar una nueva cuenta

Conectarse

¿Ya tienes una cuenta? Conéctate aquí.

Conéctate ahora

×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.