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.

Visualizar tela Windows-Copiando Arquivos

Perguntas e Repostas sobre os artigos, posts e arquivos que são postados no site
Avatar do usuário
TARSA
Colaborador
Colaborador
Mensagens: 33
Registrado em: Dom Set 11, 2016 5:04 pm

Visualizar tela Windows-Copiando Arquivos

Mensagem por TARSA » Dom Mar 29, 2020 7:04 pm

Prezados(as),

Tenho uma rotina em VBA que está totalmente funcional, mas gostaria que mostrasse a janela do Windows dos arquivos que estão sendo copiados. Alguém poderia me ajudar?

Obrigado.
TELA_COPIANDO.jpg
TELA_COPIANDO.jpg (67.22 KiB) Exibido 8536 vezes



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
TARSA
Colaborador
Colaborador
Mensagens: 33
Registrado em: Dom Set 11, 2016 5:04 pm

Re: Visualizar tela Windows-Copiando Arquivos

Mensagem por TARSA » Seg Mar 30, 2020 12:51 pm

Olá Thomas, segue abaixo o código que realiza a cópia. Obg.

Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim Form_wait As UserForm
Dim strCaminho2 As String
Dim strCaminho3 As String

strCaminho2 = ThisWorkbook.Path 'Plan10.Range("LOCAL_BKP")
strCaminho3 = Plan10.Range("LOCAL_PENDRIVE")


ActiveWorkbook.Save


FromPath = strCaminho2 'DIRETÓRIO DE ORIGEM
ToPath = strCaminho3 '"DIRETÓRIO PENDRIVE DEFINIDO POR OUTRA ROTINA" '<< DIRETÓRIO ALVO


If Right(FromPath, 10) = "\" Then
FromPath = Left(FromPath, Len(FromPath) - 10)
End If

If Right(ToPath, 1) = "\" Then
ToPath = Left(ToPath, Len(ToPath) - 1)
End If

Set FSO = CreateObject("scripting.filesystemobject")

If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " NÃO EXISTE !!!"
Exit Sub

End If

FSO.CopyFolder Source:=FromPath, Destination:=ToPath



Avatar do usuário
webmaster
Administrador
Mensagens: 2789
Registrado em: Sex Jul 24, 2009 2:44 pm
Contato:

Re: Visualizar tela Windows-Copiando Arquivos

Mensagem por webmaster » Seg Mar 30, 2020 2:19 pm

TARSA,

Foi o mais próximo que achei:

https://stackoverflow.com/questions/142 ... ogress-bar

Essa não é uma tarefa natural do FileSystemObject, por isso o artigo mostra a operação sendo feta via SHFileOperation com chamada de API direta.

Não testei


Tomás
https://www.tomasvasquez.com.br/blog
https://www.tomasvasquez.com.br/cursocsharp
https://twitter.com/tomamais
Se sua dúvida foi solucionada, acrescente [RESOLVIDO] ao título.

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
TARSA
Colaborador
Colaborador
Mensagens: 33
Registrado em: Dom Set 11, 2016 5:04 pm

Re: Visualizar tela Windows-Copiando Arquivos

Mensagem por TARSA » Seg Mar 30, 2020 2:54 pm

Ok Thomás, vou testar e após adaptar. Muito Obrigado.



Avatar do usuário
TARSA
Colaborador
Colaborador
Mensagens: 33
Registrado em: Dom Set 11, 2016 5:04 pm

Re: Visualizar tela Windows-Copiando Arquivos

Mensagem por TARSA » Sex Abr 03, 2020 1:35 pm

Public Declare Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Public Const FO_COPY = &H2
Public Const FOF_SIMPLEPROGRESS = &H100

Public Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As Long

End Type

Public Sub VBCopyFolder(ByRef strSource As String, ByRef strTarget As String)
Dim op As SHFILEOPSTRUCT

With op
.wFunc = FO_COPY
.pTo = strTarget
.pFrom = strSource
.fFlags = FOF_SIMPLEPROGRESS
End With

SHFileOperation op

End Sub

Sub COPIAR()
'~~> Copy Files

CreateObject("Scripting.FileSystemObject").DeleteFolder "DIRETÓRIO DE DESTINO" 'Essa linha se refere a deleção do DIRETÓRIO DE DESTINO, senão desejar apagar o diretório antes da cópia, desabilite essa linha.

Call VBCopyFolder("DIRETÓRIO ORIGEM\*.*", "DIRETÓRIO DE DESTINO\")

End Sub


OBS.: COLOCAR O CÓDIGO EM UM MODULO QUALQUER.



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.


Responder