Com este comando faço cópias de segurança para a PenDrive.
Será possivel compactar tudo isto num zip, ou rar.
Obrigado
Public Function CopiaDriveE()
On Error Resume Next
If MsgBox("Deseja Fazer Backup do Programa " & Chr(13) & "" & [Programa] & " " & [Tipo] & "" & Chr(13) & "Drive Destino " & [cxPasta1] & "? ", vbYesNo, "Aviso de Cópias de Segurança") = vbYes Then
Me.Rótulo12.Visible = True
Me.Rótulo11.Visible = False
Me.Backup = Now
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.folderexists(Me.CaminhoEscolhido) Then ' verifica se já existe a pasta
If MsgBox("Pasta já Existe .... Continuar e Substituir a Pasta Existente ?", vbOKCancel, "Aviso?") = vbCancel Then
GoTo sai
End If
Else
MkDir Me.CaminhoEscolhido ' se não existir cria
End If
Dim fs As Object
Dim PathInicial As String, PathFinal As String
PathInicial = CurrentProject.path
PathFinal = CaminhoEscolhido
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile PathInicial & "\" & Me.NomeBaseDados, PathFinal & "\" & Me.NomeBaseDados
fs.CopyFile PathInicial & "\" & "StrStorage.dll", PathFinal & "\" & "StrStorage.dll"
fs.CopyFile PathInicial & "\" & "dynapdf.dll", PathFinal & "\" & "dynapdf.dll"
fs.CopyFolder PathInicial & "\" & "PDF", PathFinal & "PDF"
fs.CopyFolder PathInicial & "\" & "Tabelas", PathFinal & "Tabelas"
fs.CopyFile PathInicial & "\" & "Assis.ico", PathFinal & "\" & "Assis.ico"
fs.CopyFile PathInicial & "\" & "MouseHook.dll", PathFinal & "\" & "MouseHook.dll"
fs.CopyFile PathInicial & "\" & "AirLock.bmp", PathFinal & "\" & "AirLock.bmp"
fs.CopyFile PathInicial & "\" & "Bancos.png", PathFinal & "\" & "Bancos.png"
fs.CopyFile PathInicial & "\" & "Tirarmensagem.exe", PathFinal & "\" & "Tirarmensagem.exe"
fs.CopyFolder PathInicial & "\" & "Imagens", PathFinal & "Imagens"
MsgBox "A Cópia de Segurança do Programa. " & vbCrLf & "" & [Programa] & " " & [Tipo] & " " & vbCrLf & "Foi Efectuada Com Sucesso", vbInformation, "" & [Programa] & " " & [Tipo] & ""
DoCmd.Close acForm, "Menu"
DoCmd.Close acForm, "Backup"
sai: DoCmd.Quit
End If
End Function
Última edição por Assis em 16/5/2013, 19:30, editado 3 vez(es)