Como MOVER ARCHIVO a Otro DIRECTORIO DESDE un LISTBOX de Excel VBA #552

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.

  

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.

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