Vídeo recomendado
https://youtu.be/diWPPPhW-9E
https://youtu.be/diWPPPhW-9E
Visualizar tela Windows-Copiando Arquivos
Visualizar tela Windows-Copiando Arquivos
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.
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.
Re: Visualizar tela Windows-Copiando Arquivos
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
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
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
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
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.
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.