ATENÇÃO NOVOS USUÁRIOS

Se registrou recentemente? Seu cadastro será avaliado e mendiante aprovação, a conta será ativada e você poderá usufruir do fórum. O tempo de avaliação gira em torno de 24 a 48 horas.

Esqueceu sua senha?

Você pode usar o mecanismo de lembrete neste link: Recuperar senha

Você receberá um link de reativação no email cadastrado.

Não recebeu o email? Lembre-se checar o Lixo Eletrônico.

PROGRESS BAR QUE CONTA ARQUIVOS

Fórum para dúvidas sobre os fundamentos da linguagem de programação Visual Basic no contexto do VBA
Avatar do usuário
TARSA
Colaborador
Colaborador
Mensagens: 35
Registrado em: Dom Set 11, 2016 5:04 pm

PROGRESS BAR QUE CONTA ARQUIVOS

Mensagem por TARSA » Sáb Nov 03, 2018 4:33 pm

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



Disable adblock

This site is supported by ads and donations.
If you see this text you are blocking our ads.
Please consider a Donation to support the site.


Avatar do usuário
Mikel Silveira Fraga
Jedi
Jedi
Mensagens: 1122
Registrado em: Sex Mai 27, 2011 3:27 pm
Localização: Betim - MG
Contato:

Re: PROGRESS BAR QUE CONTA ARQUIVOS

Mensagem por Mikel Silveira Fraga » Qua Dez 19, 2018 1:15 am

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.


Gostou da dica? Clique no JOIA no topo da mensagem.
Esclareceu suas dúvidas? Acrescente ao título do tópico a expressão: [RESOLVIDO].
Orientações sobre o fórum, acesse aqui.

Mikel Silveira Fraga
E-mail: mikel-sf@hotmail.com | Linked In

Responder