oi, em um modulo
Option Explicit
Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As Any) As Long
Public Declare Sub SHFreeNameMappings Lib "shell32.dll" (ByVal hNameMappings As Long)
Public Declare Sub CopyMemory Lib "KERNEL32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Public Type SHFILEOPSTRUCT
hwnd As Long
wFunc As FO_Functions
pFrom As String
pTo As String
fFlags As FOF_Flags
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As String 'only used if FOF_SIMPLEPROGRESS
End Type
Public Enum FO_Functions
FO_MOVE = &H1
FO_COPY = &H2
FO_DELETE = &H3
FO_RENAME = &H4
End Enum
Public Enum FOF_Flags
FOF_MULTIDESTFILES = &H1
FOF_CONFIRMMOUSE = &H2
FOF_SILENT = &H4
FOF_RENAMEONCOLLISION = &H8
FOF_NOCONFIRMATION = &H10
FOF_WANTMAPPINGHANDLE = &H20
FOF_ALLOWUNDO = &H40
FOF_FILESONLY = &H80
FOF_SIMPLEPROGRESS = &H100
FOF_NOCONFIRMMKDIR = &H200
FOF_NOERRORUI = &H400
FOF_NOCOPYSECURITYATTRIBS = &H800
FOF_NORECURSION = &H1000
FOF_NO_CONNECTED_ELEMENTS = &H2000
FOF_WANTNUKEWARNING = &H4000
End Enum
Public Type SHNAMEMAPPING
pszOldPath As String
pszNewPath As String
cchOldPath As Long
cchNewPath As Long
End Type
Public result As Long
Public Function SHFileOP(ByRef lpFileOp As SHFILEOPSTRUCT) As Long
Dim lenFileop As Long
Dim foBuf() As Byte
lenFileop = LenB(lpFileOp)
ReDim foBuf(1 To lenFileop) 'the size of the structure.
Call CopyMemory(foBuf(1), lpFileOp, lenFileop)
Call CopyMemory(foBuf(19), foBuf(21), 12)
result = SHFileOperation(foBuf(1))
SHFileOP = result
End Function
Para Chamar A função em um Form
Private Sub FazerBackup()
Dim linha As String
linha = Chr(10) & Chr(13)
Me.Visible = False
On Error GoTo DBErrorHandler
Copiar App.Path & "*.*", "E:Sistema Br Trans"
On Error GoTo 0
Exit Sub
DBErrorHandler:
End
SubExit:
Unload Me
End Sub
Sub Copiar(strOrigem As String, strDestino As String)
With fileop
.hwnd = 0
.wFunc = FO_COPY
.pFrom = strOrigem & vbNullChar & vbNullChar
.pTo = strDestino & vbNullChar & vbNullChar
.lpszProgressTitle = "Aguarde, realizando copia..."
.fFlags = FOF_NOCONFIRMATION 'FOF_NOCOPYSECURITYATTRIBS 'FOF_MULTIDESTFILES FOF_SIMPLEPROGRESS Or
End With
lret = SHFileOP(fileop)
If result <> 0 Then 'a operaçao falhou
MsgBox Err.MaxDllError 'exibe o erro retornado pela API
Else
If fileop.fAnyOperationsAborted <> 0 Then
MsgBox "Operação falhou !!!"
End If
End If
End Sub