在打开数据库时自动备份

Question

任何人都可以给我创建打开数据库的备份/副本的代码吗？它知道如何使用autoexec宏，我只需要代码。该数据库名是Datenbank和回有回的时间，它的名字

Answer 1

该命令可能是：

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

，但你不能这样做，数据库文件本身从内部应用程序。

你最好的选择是创建一个运行脚本的快捷方式，该脚本首先复制文件，然后打开它。

附录

我位于将创建当前项目的压缩备份功能：

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