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
Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
PROGRESS BAR QUE CONTA ARQUIVOS
- Mikel Silveira Fraga
- Jedi
- Mensagens: 1173
- Registrado em: Sex Mai 27, 2011 3:27 pm
- Localização: Governador Valadares - MG
- Contato:
Re: PROGRESS BAR QUE CONTA ARQUIVOS
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.
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.