Vídeo recomendado
https://youtu.be/diWPPPhW-9E

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: 36
Registrado em: Dom Set 11, 2016 5:04 pm

Visualizar tela Windows-Copiando Arquivos

Mensagem por TARSA »

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 14469 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
webmaster
Administrador
Mensagens: 3114
Registrado em: Sex Jul 24, 2009 2:44 pm
Contato:

Re: Visualizar tela Windows-Copiando Arquivos

Mensagem por webmaster »

Qual o código?


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

Re: Visualizar tela Windows-Copiando Arquivos

Mensagem por TARSA »

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: 3114
Registrado em: Sex Jul 24, 2009 2:44 pm
Contato:

Re: Visualizar tela Windows-Copiando Arquivos

Mensagem por webmaster »

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


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: 36
Registrado em: Dom Set 11, 2016 5:04 pm

Re: Visualizar tela Windows-Copiando Arquivos

Mensagem por TARSA »

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


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

Re: Visualizar tela Windows-Copiando Arquivos

Mensagem por TARSA »

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