PROGRESS BAR QUE CONTA ARQUIVOS

[TARSA]

Boa tarde Pessoal,

Estou tentando inserir uma Progress Bar em um form de um tipo específico, porém não roda de jeito nenhum. Como é uma rotina de copiar arquivos <Diretório> para o Pen Drive a mesma é demorada.
Achei o código abaixo do Macoratti em VBA-Access, mas também não consegui adaptar para o VBA-EXcel. Alguém pode me dar uma ajuda?

-----------------------------------------------------Abaixo texto Macoratti----------------------------------------------

Sendo que no Form tenho duas progressbar (a pgrFileCopy para mostrar o progresso do ficheiro actual e a pgrTotalCopy para mostrar o progresso do total de ficheiros), e uma label (lblAcopiar para mostrar o nome do ficheiro que está a ser copiado)


Public Class frmCopy
Dim sPath As String = "C:\Pasta_Origem\"
Dim lPath As String = "C:\Pasta_Destino\"


Private Sub frmMain_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
cpyFiles()
End Sub

Private Delegate Function CopyProgressRoutine(ByVal totalFileSize As Int64, ByVal totalBytesTransferred As Int64, ByVal streamSize As Int64, ByVal streamBytesTransferred As Int64, ByVal dwStreamNumber As Int32, ByVal dwCallbackReason As Int32, ByVal hSourceFile As Int32, ByVal hDestinationFile As Int32, ByVal lpData As Int32) As Int32

Private Declare Auto Function CopyFileEx Lib "kernel32.dll" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal lpProgressRoutine As CopyProgressRoutine, ByVal lpData As Int32, ByVal lpBool As Int32, ByVal dwCopyFlags As Int32) As Int32

Private Function CopyProgress(ByVal totalFileSize As Int64, ByVal totalBytesTransferred As Int64, ByVal streamSize As Int64, ByVal streamBytesTransferred As Int64, ByVal dwStreamNumber As Int32, ByVal dwCallbackReason As Int32, ByVal hSourceFile As Int32, ByVal hDestinationFile As Int32, ByVal lpData As Int32) As Int32
pgrFileCopy.Value = Convert.ToInt32(totalBytesTransferred / totalFileSize * 100)
End Function

Private Sub cpyFiles()
Dim cpr As New CopyProgressRoutine(AddressOf CopyProgress)
Dim allfiles() As String = IO.Directory.GetFiles(sPath)
Dim filesCopyed As Integer = 0
pgrTotalCopy.Maximum = allfiles.Length - 1
For Each file As String In allfiles
Dim fileName() As String = file.Split("\")
lblAcopiar.Text = "A copiar: " & fileName(fileName.Length - 1)
CopyFileEx(file, lPath & fileName(fileName.Length - 1), cpr, 0, 0, 0)
filesCopyed += 1
pgrTotalCopy.Value = filesCopyed
Next
End Sub
End Class

[Mikel Silveira Fraga]

Tarsa, boa noite.

Seguinte, vendo esse código que o Macoratti postou, acredito que não seja um código para Office VBA, mas sim para uso no VB.Net.

Mesmo assim vou procurar o link desta postagem, tentar entender o funcionamento do mesmo e tentar adaptar ao processo que vocês precisam.

Qualquer coisa ou outros problemas, estou a disposição.