Como COPIAR ARCHIVO a OTRO DIRECTORIO desde un LISTBOX de Excel VBA #553

REPLICAR FICHERO MEDIANTE MACRO DE EXCEL

En esta oportunidad se muestra una macro que permite copiar archivos de un directorio  a otro, todo a través de macros de Excel VBA, el ejemplo consiste en un primer momento en listar los archivos de una carpeta y subcarpeta y mostrarlos en un listbox de Excel, seleccionar un archivo y presionando un botón se copia dicho archivo en otro directorio.

Opera Excel como un profesional, click acá, si quieres aprender sobre Excel en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet, te lo recomiendo no te arrepentirás.

  

Para un mejor y más fácil entendimiento sugiero descargar el archivo de Excel utilizado en el ejemplo, lo cual se puede hacer desde el final de post en forma absolutamente gratuita.

Para ver como funciona el ejemplo, primero se debe listar los archivos de una carpeta y subcarpeta de Excel, luego estos archivos son mostrados en el listbox que se encuentra en el formulario.

Para copiar un archivo, se debe seleccionar el ítem en el listbox, luego presionar el ícono blanco con las flechas verde y roja, esto ejecuta una macro que en un primero momento obtiene el valor de unas variables y luego muestra un formulario, que solicita un password o clave para proseguir con la ejecución de la macro.

Ingresado el password correcto, que es «admin» (en minúscula y sin las comillas), se muestra un explorador de archivo que permite seleccionar el directorio donde se requiere copiar el archivo y luego se copia.

Explicación del código que COPIA FICHEROS CON MACROS EXCEL

VBA

Como se dijo anteriormente, se debe seleccionar en el listbox el archivo a copiar, la macro en ese momento obtiene la dirección, ruta o path del archivo que se desea copiar, lo cual lo obtiene de la columna 3 del listbox, luego carga en la variable «nummacro» el número que identifica de donde se está ejecutando o llamando  la macro, se usan los códigos:

copyoldarc = (UserForm9.ListBox1.List(ListBox1.ListIndex, 3))
nunmacro = 4
UserForm8.Show

Luego de ejecutar los códigos mencionados en el párrafo anterior se muestra el formulario que solicita el password, introducida la clave correcta que en este ejemplo es «admin», sale un Msgbox que pregunta os veces si se desea continuar con la operación, en este caso es el copiado del archivo, el código usado es:

If TextBox1 = «admin» Then
Unload Me

Select Case nunmacro
Case Is = 1
resp = MsgBox(«Está por eliminar el archivo seleccionado, seguro requiere eliminar el fichero?», vbInformation + vbOKCancel, «AVISO»)
If resp = 1 Then
‘Vuelve a preguntar por segunda vez que confirme eliminación archivo

En caso que se continúe con la solicitud de copiar el archivo, se determina con el comando Select Case cual es la macro que llamo el procedimiento y en base a ello que código aplicar.

En este caso habíamos establecido que el código de donde se llamaba la macro era el 4, contenido en la variable, «nunmacro = 4», encontrado el número se procede a determinar el nombre con el que se copiará el archivo en el directorio seleccionado.

Para determinar donde se debe copiar el archivo, se muestra un explorador de archivos donde se debe seleccionar el directorio donde se desea copiar el archivo:

path1 = CreateObject(«shell.application»).browseforfolder(0, «Seleccione Carpeta», 0).Items.Item.Path

Luego se determinar el nombre del fichero nuevo con los siguientes códigos:

nomcap = StrReverse(copyoldarc)
nomcap = Left(nomcap, (Len(nomcap) – (Len(nomcap) – InStr(nomcap, «\»)) – 1))
nomfich = StrReverse(nomcap)
copynewarc = path1 & «\» & nomfich

Se procede a copiar el fichero con el siguiente código:

FileCopy copyoldarc, copynewarc

Código VBA para copiar ficheros con Macro de Excel VBA

Código insertado en el formulario 8

Private Sub CommandButton1_Click()
Dim resp As Integer
On Error Resume Next

If TextBox1 = «admin» Then
Unload Me

Select Case nunmacro
Case Is = 1
resp = MsgBox(«Está por eliminar el archivo seleccionado, seguro requiere eliminar el fichero?», vbInformation + vbOKCancel, «AVISO»)
If resp = 1 Then
‘Vuelve a preguntar por segunda vez que confirme eliminación archivo
resp = MsgBox(«El archivo no se podrá recuperar, seguro requiere eliminar el archivo seleccionado?», vbCritical + vbOKCancel, «AVISO»)
If resp = 1 Then
Kill (myfilekill)
UserForm9.ListBox1.RemoveItem fila
MsgBox («El archivo se eliminó con éxito»), vbInformation, «AVISO»
End If
End If
Case Is = 2
resp = MsgBox(«Está por cambiar el nombre del archivo seleccionado, seguro requiere editar el nombre del fichero?», vbInformation + vbOKCancel, «AVISO»)
If resp = 1 Then
nomfich = Application.InputBox(prompt:=»Establezca el nuevo nombre del archivo:», Type:=2)
nomcap = StrReverse(nomold)
exten = Left(nomcap, InStr(nomcap, «.») – 1)
exten = StrReverse(exten)
nomcap = Mid(nomcap, InStr(nomcap, «\») + 1)
nomcap = StrReverse(nomcap)
nomnew = nomcap & «\» & nomfich & «.» & exten
Name nomold As nomnew

UserForm9.ListBox1.List(fila, 1) = nomfich & «.» & exten
UserForm9.ListBox1.List(fila, 3) = nomnew
MsgBox («El archivo se renombró con éxito»), vbInformation, «AVISO»
End If

Case Is = 3
resp = MsgBox(«Está por mover el archivo seleccionado, seguro requiere mover de directorio el fichero?», vbInformation + vbOKCancel, «AVISO»)
If resp = 1 Then
path1 = CreateObject(«shell.application»).browseforfolder(0, «Seleccione Carpeta», 0).Items.Item.Path

nomcap = StrReverse(folold)
nomcap = Left(nomcap, (Len(nomcap) – (Len(nomcap) – InStr(nomcap, «\»)) – 1))
nomfich = StrReverse(nomcap)
folnew = path1 & «\» & nomfich
Name folold As folnew

UserForm9.ListBox1.List(fila, 1) = nomfich
UserForm9.ListBox1.List(fila, 3) = folnew
MsgBox («El archivo se movio con éxito»), vbInformation, «AVISO»
End If

Case Is = 4
resp = MsgBox(«Se va a copiar el archivo seleccionado, seguro requiere copiar el fichero?», vbInformation + vbOKCancel, «AVISO»)
If resp = 1 Then
path1 = CreateObject(«shell.application»).browseforfolder(0, «Seleccione Carpeta», 0).Items.Item.Path

nomcap = StrReverse(copyoldarc)
nomcap = Left(nomcap, (Len(nomcap) – (Len(nomcap) – InStr(nomcap, «\»)) – 1))
nomfich = StrReverse(nomcap)
copynewarc = path1 & «\» & nomfich
FileCopy copyoldarc, copynewarc

MsgBox («El archivo se copió con éxito»), vbInformation, «AVISO»
End If

End Select

Else
MsgBox («La clave ingresada para eliminar archivos es incorrecta, verifique»), vbInformation, «AVISO»
TextBox1 = Clear
TextBox1.SetFocus
End If
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub UserForm_Click()

End Sub

Código insertado en el formulario 9

Private Sub CommandButton24_Click()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim path1 As String, subcarpeta As Object

UserForm9.Caption = «ARCHIVOS ASOCIADOS»
UserForm9.ListBox1.ColumnCount = 5
UserForm9.ListBox1.ColumnWidths = «20 pt; 320 pt; 100 pt; 1000 pt»

‘Indicamos la ruta de donde vamos a obtener
path1 = CreateObject(«shell.application»).browseforfolder(0, «Seleccione Carpeta», 0).Items.Item.Path
If path1 = «» Then
MsgBox «No ha seleccionado directorio, seleccione un directorio .», , «AVISO»
Exit Sub
End If
‘Se crea FileSystemObject que da acceso al sistema de archivos del sistema
Set fso = CreateObject(«Scripting.FileSystemObject»)
‘Definimos variables para determinar nombre de archivos y subcarpetas
Set carpeta = fso.getfolder(path1)
Set ficheros = carpeta.Files
Set subcarp = carpeta.SubFolders

UserForm9.ListBox1.Clear
UserForm9.ListBox1.AddItem

‘Esto es para ver archivos dentro de la subcarpeta del nombre del archivo y de la Circunscripción Correspondiente
For Each subcarp In subcarp
f = subcarp.Name
Set carpetasubfol = fso.getfolder(subcarp)
Set ficherossubfol = carpetasubfol.Files
For Each ficherossubfol In ficherossubfol
b = ficherossubfol.Name
NunFic = NunFic + 1
UserForm9.ListBox1.AddItem NunFic
UserForm9.ListBox1.List(UserForm9.ListBox1.ListCount – 1, 1) = b
UserForm9.ListBox1.List(UserForm9.ListBox1.ListCount – 1, 2) = FileDateTime(ficherossubfol)
UserForm9.ListBox1.List(UserForm9.ListBox1.ListCount – 1, 3) = subcarp & «\» & b
‘End If
Next ficherossubfol
Next subcarp

‘Archivos
For Each ficheros In ficheros
b = ficheros.Name
esp = InStr(b, » «)
nomfic = Val(Left(b, esp))
NunFic = NunFic + 1
UserForm9.ListBox1.AddItem NunFic
UserForm9.ListBox1.List(UserForm9.ListBox1.ListCount – 1, 1) = b
UserForm9.ListBox1.List(UserForm9.ListBox1.ListCount – 1, 2) = FileDateTime(ficheros)
UserForm9.ListBox1.List(UserForm9.ListBox1.ListCount – 1, 3) = carpeta & «\» & b
Next ficheros

Set carpetasubfol = Nothing
Set ficherossubfol = Nothing
Set carpeta = Nothing
Set ficheros = Nothing

UserForm9.ListBox1.List(0, 0) = «ID»
UserForm9.ListBox1.List(0, 1) = «Nombre de Archivo»
UserForm9.ListBox1.List(0, 2) = «Fecha de Creación / Modificación»
UserForm9.ListBox1.List(0, 3) = «Path»

UserForm9.ListBox1.AddItem
UserForm9.ListBox1.AddItem
UserForm9.ListBox1.AddItem
UserForm9.ListBox1.List(UserForm9.ListBox1.ListCount – 1, 3) = «Total de registros: » & UserForm9.ListBox1.ListCount – 4

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Private Sub CommandButton25_Click()
On Error Resume Next
myfilekill = (UserForm9.ListBox1.List(ListBox1.ListIndex, 3))
fila = UserForm9.ListBox1.ListIndex
nunmacro = 1
UserForm8.Show
End Sub

Private Sub CommandButton26_Click()
Unload UserForm9
End Sub

Private Sub CommandButton27_Click()
On Error Resume Next
nomold = (UserForm9.ListBox1.List(ListBox1.ListIndex, 3))
fila = UserForm9.ListBox1.ListIndex
nunmacro = 2
UserForm8.Show
End Sub

Private Sub CommandButton28_Click()
On Error Resume Next
folold = (UserForm9.ListBox1.List(ListBox1.ListIndex, 3))
fila = UserForm9.ListBox1.ListIndex
nunmacro = 3
UserForm8.Show
End Sub

Private Sub CommandButton29_Click()
On Error Resume Next
copyoldarc = (UserForm9.ListBox1.List(ListBox1.ListIndex, 3))
‘fila = UserForm9.ListBox1.LiAstIndex
nunmacro = 4
UserForm8.Show
End Sub

Private Sub UserForm_Initialize()
UserForm9.Top = 100
UserForm9.Left = 135
UserForm9.Width = 830
UserForm9.Height = 350
End Sub

Descarga la Macro de Excel «Mover archivos con Macros VBA»

Descarga el Libro de Excel usado como ejemplo en este post y en el vídeo explicativo, el mismo es totalmente gratuito y libre su uso, solicito aportar para sostener esta web, si está dentro de tus posibilidades, desde ya muchas gracias.

Donate:
Cuenta Paypal: https://paypal.me/programarexcel
Cuenta Bitcoin: 1KBGGb8fyDzyR3X1Rie6m7VguzaAfngNbd
Cuenta Ether: 0x41Bbd24556914C83a31217eBb3BC49789b66e407