[Resolvido]VBA para gerar uma cópia do Access ao fechar.

Olá pessoal, bom dia !
Dentro deste meu código eu preciso inserir um para gerar uma cópia do BD.
Já tentei um monte de códigos especificos para backup e nenhum rodou.
Tem como esta cópia ser compactada e com o nome tipo assim:  "NomeDoBancoDeDados yyyymmmdd hhnnss"  
(SO:Window7/Access2010)

Código:


Private Sub BtnSair_Click()
    If MsgBox("Deseja realmente fechar o programa?", vbYesNo + vbDefaultButton1, "Aviso!") = vbYes Then
    Application.Quit
    Else
    Cancel = True
    End If
End Sub


Obrigado!!

.

Ola bom dia !

Nunca utilize o Cancel=True, em Sub`s que não tenham essa função invocada.
Para esses Sub`s como o botão use sempre o Exit Sub.

Faça o teste e retorne;

Código:

Private Sub Command0_Click()
Dim fs As Object
Dim oldOrigem As String, oldDestino As String

   If MsgBox("Deseja realmente fechar o programa?", vbYesNo + vbDefaultButton1, "Aviso!") = vbYes Then

oldOrigem = "D:\PastaOrigem" 'Caminho onde está o banco
oldDestino = "D:\PastaDestino" 'Caminho para onde vai a copia do banco
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile oldOrigem & "\" & "NomeDoBanco.accdb", oldDestino & "\" & "NomeDoBanco" & Format(Now(), "yyyymmdd_hhnnss") & ".accdb"
Set fs = Nothing
    Application.Quit
    Else
    Exit Sub
End If
End Sub

PERFEITO !

Rodou direitim!
Pergunta final: Esta cópia tem como ser compactada ? Tipo Zip ou Rar ?

.

Veja se ajuda:

https://www.maximoaccess.com/t22585-resolvidocodigo-para-backup-zipado?highlight=backup+compactado

Olá
Estou em viagem, mas é isso ae nesse link.

O código está depositado no link da minha assinatura 102 Códigos VBA.

Olá mestre JPaulo,
Me desculpe não ter citado seu nome pois confesso que ao observar o codigo, pulei as primeiras linhas.

.

ahteixeira em https://www.maximoaccess.com/t22585-resolvidocodigo-para-backup-zipado?highlight=backup+compactado tem um anexo pronto. É um BD que zipa outro BD.
Seguindo a linha do ahteixeira, o código abaixo zipa a si próprio.

Código:


Private Sub ZipaBanco_Click()
'JPaulo ? Maximo Access
'http://www.maximoaccess.com/t16321-resolvidoenviar-arquivo-zipado-por-e-mail-no-mesmo-evento

Dim strDate As String, DefPath As String
Dim oApp As Object
Dim FName, FileNameZip
Dim strPrefix As String
On Error Resume Next

    DefPath = Application.CurrentProject.Path & "\" & "PastaDestino"
'                                                     "PastaDestino" Nome da pasta onde o banco vai cair zipado

     'verifica se existe pasta destino
    If Len(Dir(DefPath, vbDirectory) & "") = 0 Then
        MsgBox "Não existe caminho para backup: " & DefPath
        Exit Sub
    End If
    
    If Right(DefPath, 1) <> "\" Then
        DefPath = DefPath & "\"
    End If

    strDate = Format(Now, "yyyymmdd_hhmmss")
    FileNameZip = DefPath & "MeuBanco_" & strDate & ".zip"
'                           "MeuBanco_" é o nome fixo do arquivo

    strPrefix = "BancoTrabalho" '
'               "BancoTrabalho" é o nome do banco que vai ser zipado.


    'FName ? o caminho da pasta onde vai ficar o banco zipado.
    'neste exemplo vai ficar junto ao proprio banco
    'Se o seu Ms Access for anterior ao 2007,
    'deve alterar a exten??o de .accdb para .mdb
    FName = Application.CurrentProject.Path & "\" & strPrefix & ".accdb"

    'verifica se existe ficheiro
    If Len(Dir(FName) & "") = 0 Then
        MsgBox "Não existe o ficheiro: " & FName
        Exit Sub
    End If
 

    On Error Resume Next
    CriaNovoZip (FileNameZip)
    Set oApp = CreateObject("Shell.Application")
    oApp.NameSpace(FileNameZip).CopyHere FName
    MsgBox "Criado com Sucesso em: " & FileNameZip
    Set oApp = Nothing
    Exit Sub
End Sub


Public Sub CriaNovoZip(sPath)
'Criado pelo meu amigo e colega Raw do Canada
'Adaptado por JPaulo ? Maximo Access
Dim ofso, arrHex, sBin, i, Zip
On Error Resume Next
Set ofso = CreateObject("Scripting.FileSystemObject")
arrHex = Array(80, 75, 5, 6, 0, 0, 0, _
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
For i = 0 To UBound(arrHex)
sBin = sBin & Chr(arrHex(i))
Next
On Error Resume Next
With ofso.CreateTextFile(sPath, True)
.Write sBin
.Close
End With
Exit Sub
End Sub





Obrigado pessoal !!!!!  


.

Paulo tudo bem?

Fiz uma macro no access e um .Bat para executar.

Na macro coloquei uma condição de fechar o banco após execerrar.

não consigo mais alterar e nem abrir essa droga...

pode ajudar.


Obrigado...

Paulo ,

Coloquei o código abaixo sugerido por vc,
Perfeito.

@echo off
echo Iniciado em %date% %time%
echo.
echo - aguarde...
echo.
echo - a ligar aguarde...
echo.
echo.
echo - a concluir...
START /WAIT Msaccess.exe "C:\xxxxxxxxxxxxxxxxxxxxxxxxxxx" /x "xxxxxxxxxxxx"

Porem na macro coloquei uma condição de fechar o banco.
Por conta deste comando não consigo mais alterar e nem abrir a macro ou o banco.

ele executa e fecha...

Pode ajudar.