Página 1 de 1

Visualizar tela Windows-Copiando Arquivos

Enviado: Dom Mar 29, 2020 7:04 pm
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 8535 vezes

Re: Visualizar tela Windows-Copiando Arquivos

Enviado: Dom Mar 29, 2020 9:24 pm
por webmaster
Qual o código?

Re: Visualizar tela Windows-Copiando Arquivos

Enviado: Seg Mar 30, 2020 12:51 pm
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

Re: Visualizar tela Windows-Copiando Arquivos

Enviado: Seg Mar 30, 2020 2:19 pm
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

Re: Visualizar tela Windows-Copiando Arquivos

Enviado: Seg Mar 30, 2020 2:54 pm
por TARSA
Ok Thomás, vou testar e após adaptar. Muito Obrigado.

Re: Visualizar tela Windows-Copiando Arquivos

Enviado: Sex Abr 03, 2020 1:35 pm
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.