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

打开数据库的自动备份

1 个答案: