MOVER FICHERO MEDIANTE MACRO DE EXCEL
En este ejemplo se muestra una macro de excel que permite mover archivos de un directorio a otro donde el archivo a mover se selecciona de un listbox de Excel, donde previamente fueron listados los archivos de un directorio y subdirectorio.
Necesitas aprender a manejar Excel, 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.
聽
聽
Mira la macro en acci贸n, una explicaci贸n m谩s detallada de su codificaci贸n y funcionamiento, recomiendo observar para una m谩s f谩cil comprensi贸n de la macro; suscribe a nuestro canal de You Tube, mira el playlist con聽 v铆deos relacionados donde podr谩s ver la macros relacionadas en acci贸n con una explicaci贸n en forma visual que ayudar谩 a entender el ejemplo en forma m谩s f谩cil.
MOVER ARCHIVO CON EXCEL VBA
Este ejemplo la macro mueve un archivo seleccionado de un listado que se encuentra en un Listbox de Excel VBA, seleccionado el archivo y presionando el bot贸n que tiene de icono dos carpetas, se muestra un formulario para que se ingrese el password o contrase帽a, la cual es “admin”.
Ingresada la contrase帽a correcta, la macro pregunta dos veces si se desea mover el archivo de lugar en nuestra PC, en caso negativo cierra el Msgbox y no hace nada, en caso afirmativo mueve la carpeta al lugar seleccionado en el explorador de archivos que aparece para que seleccionemos la carpeta de destino.
Explicaci贸n del c贸digo para MOVER de ficheros de un directorio a otro con macros VBA
Presionando el bot贸n para mover archivos, cuyo icono est谩 representado por dos carpetas, se empieza a ejecutar la macro tendiente a mover el archivo que previamente se debe hacer seleccionado en el listbox, para ello carga en la variable “folold” el path del archivo a mover que est谩 en la columna 3 del listbox, determina la fila en el listbox donde est谩 el registro a los fines luego de cargar los datos correctos en el listbox una vez cambiado de direcci贸n el archivo y por ultimo establece en la variable “nummacro” un indicador para saber de que bot贸n se est谩 llamando la macro, se usan los c贸digos:
folold = (UserForm9.ListBox1.List(ListBox1.ListIndex, 3))
fila = UserForm9.ListBox1.ListIndex
nunmacro = 3
Luego se llama al userform8 que es el que formulario que solicita el password para proceder a ejecutar la macro que mueve el archivo seleccionado de lugar.
Userform8.Show
Si se ingresa la clave correcta en el formulario se busca el c贸digo que corresponde a la macro que llama el procedimiento y que fue guardado en el variable “nummacro”
En este caso el indicador es el n煤mero 3, entonces a traves de un procedimiento Select … Case se determina cual procedimiento se debe ejecutar,聽 e inmediatamente solicita confirmaci贸n dos veces, acerca de si requiere o desea cambiar o mover el archivo de directorio, el c贸digo es el que se muestra a continuaci贸n:
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
En caso que se haya confirmado mover el archivo de lugar, se muestra un explorador de archivos de Windows para que se seleccione el nuevo directorio o carpeta de destino, con el siguiente c贸digo:
path1 = CreateObject(“shell.application”).browseforfolder(0, “Seleccione Carpeta”, 0).Items.Item.Path
Luego se extrae el nombre del fichero, de la direcci贸n que obtuvimos de la columna tres del listbox y que hab铆amos guardado anteriormente en la variable “folold”, ello a los efectos de crear el nuevo path o direcci贸n con la seleccionada en el explorador de windows y el nombre del fichero, se usan los siguientes c贸digos:
nomcap = StrReverse(folold)
nomcap = Left(nomcap, (Len(nomcap) – (Len(nomcap) – InStr(nomcap, “\”)) – 1))
nomfich = StrReverse(nomcap)
folnew = path1 & “\” & nomfich
Luego para mover el archivo de un directorio a otro se usa el siguiente c贸digo:
Name folold As folnew
Una vez movido el archivo resta solamente modificar la fila correspondiente del listbox donde estaba el nombre del archivo, esto es a los efectos de mostrar en forma actualizada el listbox de Excel, no tiene nada que ver con el movimiento del fichero que ya se realiz贸 en el paso anterior, se usan los siguientes c贸digos:
UserForm9.ListBox1.List(fila, 1) = nomfich
UserForm9.ListBox1.List(fila, 3) = folnew
MsgBox (“El archivo se movi贸 con 茅xito”), vbInformation, “AVISO”
C贸digo VBA para mover archivos listados en listbox de Excel
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
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 UserForm_Initialize()
UserForm9.Top = 100
UserForm9.Left = 135
UserForm9.Width = 830
UserForm9.Height = 350
End Sub
Descarga el Libro de Excel Usado como Ejemplo para Mover Ficheros entre Carpetas con Macro
Descarga desde ac谩 el archivo 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.
Si te fue de utilidad puedes聽INVITARME UN CAF脡聽y de esta manera ayudar a seguir manteniendo la p谩gina,聽CLICK聽para descargar en ejemplo en forma gratuita.
If this post was helpful聽INVITE ME A COFFEE聽and so help keep up the page,聽CLICK聽to download free example.
Donate:
Cuenta Paypal: https://paypal.me/programarexcel
Cuenta Bitcoin: 1KBGGb8fyDzyR3X1Rie6m7VguzaAfngNbd
Cuenta Ether: 0x41Bbd24556914C83a31217eBb3BC49789b66e407