CODEWITHSUNDEEP
ms-accessvba
f.omari
f.omari

Reputation: 19

Automatic backup on Opening database

Can anyone give me the code to create a backup/copy of the Database when opening? it I know how to use autoexec macro i just need the code. The database name is Datenbank and the back to have the time of back in its name

Upvotes: 1

Views: 1184

Answers (1)

Gustav
Gustav

Reputation: 55831

That command could be:

FileCopy CurrentDb.Name, Replace(CurrentDb.Name, ".accdb", Format(Now(), " yyyymmdd hhnnss") & ".accdb")

but you can't do that for the database file itself from inside the application.

Your best option would be to create a shortcut that runs a script that copies the file first, then opens it.

Addendum

I located a function that will create a zipped backup of the current project:

Option Compare Database
Option Explicit

' API call for sleep function.
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Function ZipCurrentProject() As Long

    Dim ShellApplication    As Object

    Dim CurrentProjectFile  As String
    Dim ZipPath             As String
    Dim ZipName             As String
    Dim ZipFile             As String
    Dim FileNumber          As Integer

    ' File and folder names.
    CurrentProjectFile = CurrentProject.Path & "\" & CurrentProject.Name
    ' The path must exist.
    ZipPath = CurrentProject.Path & "\@dbase_bk" & Format(Now, " yyyy-mm-dd hh.nn.ss") & "\"
    ZipName = "CCOLearningHub.zip"
    ZipFile = ZipPath & ZipName

    ' Create sub folder if missing.
    If Dir(ZipPath, vbDirectory) = "" Then
        MkDir ZipPath
    End If

    ' Create empty zip folder.
    FileNumber = FreeFile
    Open ZipFile For Output As #FileNumber
    Print #FileNumber, Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, vbNullChar)
    Close #FileNumber

    Set ShellApplication = CreateObject("Shell.Application")
    ' Copy the project file into the zip file.
    With ShellApplication
        Debug.Print Timer, "zipping started ..."
        .Namespace(CVar(ZipFile)).CopyHere CVar(CurrentProjectFile)
        ' Ignore error while looking up the zipped file before is has been added.
        On Error Resume Next
        ' Wait for the file to created.
        Do Until .Namespace(CVar(ZipFile)).Items.Count = 1
            ' Wait a little ...
            'DoEvents
            Sleep 100
            Debug.Print " .";
        Loop
        Debug.Print
        ' Resume normal error handling.
        On Error GoTo 0
        Debug.Print Timer, "zipping finished."
    End With

    Set ShellApplication = Nothing

    ZipCurrentProject = Err.Number

End Function

Upvotes: 1

Related Questions