Hola amigos del foro, estoy intentando hace unos días obtener la lista de archivos de un directorio y copiarlos uno por uno a otra carpeta, y que por medio de un minimo y máximo de archivos un progressbar cargue.
Ejemplo:
Carpeta c:\[Numeros]
Archivos 1.num 2.num 3.num 4.num
Copiar esto en d:\[Numeros]\*.*
Espero que me puedan ayudar.
Salu2 :D
Que llevas hasta el momento?
Cita de: e500 en 30 Diciembre 2014, 18:11 PM
Hola amigos del foro, estoy intentando hace unos días obtener la lista de archivos de un directorio y copiarlos uno por uno a otra carpeta, y que por medio de un minimo y máximo de archivos un progressbar cargue.
Ejemplo:
Carpeta c:\[Numeros]
Archivos 1.num 2.num 3.num 4.num
Copiar esto en d:\[Numeros]\*.*
Espero que me puedan ayudar.
Salu2 :D
Estoy listando los archivos de la carpeta de esta manera por el momento...
'Variable de tipo FILE y FOLDER para listar los archivos de un path
Dim El_Archivo As File
Dim El_Directorio As Folder
'Si no hay items en el List sale
If List1.ListIndex = -1 Then Exit Sub
List2.Clear
'Nuevo objeto FileSystemObject
Set Fso = New FileSystemObject
' Obtiene el directorio
Set El_Directorio = Fso.GetFolder("c:\[Numero]")
' Lista los ficheros de esta carpeta
For Each El_Archivo In El_Directorio.Files
'Añade la ruta
List2.AddItem El_Archivo.Name
Next El_Archivo
Utilizo la referencia Microsoft Scripting Runtime
Ahora voy a recorrer dicho listbox utilizando:
Call Shell("xcopy /S CARPETA DESTINO", vbMaximizedFocus)
Voy a seguir programando, sé que lo voy a lograr, pero me parece muy rebuscado mi metodo. Siempre aparece una mente brillante generando ideas muy originales.
Salu2
Bueno aquí te dejo algo, no se ve mucho el loading uno a uno pero algo es algo, ahi miras como lo arreglas.
Private Sub btnCopiar_Click()
Dim oWidth, i, oItems, oIncrement As Integer
oWidth = 222
lblProgressBar.Width = 0
If lblArchivos.ListCount > 0 Then
oItems = lblArchivos.ListCount
oIncrement = oWidth / oItems
For i = 0 To lblArchivos.ListCount - 1
FileCopy txtCarpetaArchivos.Text & lblArchivos.List(i), txtCarpetaCopiar.Text & lblArchivos.List(i)
lblProgressBar.Width = lblProgressBar.Width + oIncrement
Next
Else
MsgBox "No hay items para recorrer", vbCritical, "Error"
End If
End Sub
Private Sub btnListar_Click()
Call ListarArchivos(txtCarpetaArchivos.Text)
End Sub
Private Sub UserForm_Initialize()
txtCarpetaArchivos.Text = "C:\Users\PCSoporte\Desktop\Papeles\Enviar\"
txtCarpetaCopiar.Text = "E:\EHN\Copiar\"
lblProgressBar.Width = 0
End Sub
Public Sub ListarArchivos(oRuta As String)
Set oFso = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFso.GetFolder(oRuta)
Set oFiles = oFolder.Files
For Each oFile In oFiles
lblArchivos.AddItem oFile.Name
Next oFile
End Sub
https://dl.dropboxusercontent.com/u/71932290/EHN.xlsm
;D gracias! :D lo voy a investigar ya estoy en un 90% casi lo tengo!
Salu2