[SOLUCIONADO] Copiar carpeta de archivos con progresbar

[e500]

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  

     

[Shell Root]

Que llevas hasta el momento?

[e500]

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  

     

Estoy listando los archivos de la carpeta de esta manera por el momento...

Código [Seleccionar] Expandir


   '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:

Código [Seleccionar] Expandir


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

[Shell Root]

Bueno aquí te dejo algo, no se ve mucho el loading uno a uno pero algo es algo, ahi miras como lo arreglas.

Código (vb) [Seleccionar] Expandir

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

[e500]

  gracias! lo voy a investigar ya estoy en un 90% casi lo tengo!

Salu2