如何自动备份Access数据库

Question

我想用下面的代码自动备份访问数据库，但对我来说不起作用。我收到错误消息“找不到输入表或查询“ WinAutoBackup”。请查看图片。此外，我是否正确使用CurrentProject？

[Function fMakeBackup() As Boolean

Dim Source As String
Dim Target As String
Dim retval As Integer

On Error GoTo sysBackup_Err

Source = CurrentDb.name

Target = "CurrentProject.path\backups\" 
Target = Target & Format(Now, "yyyymmdd-hhnn") & ".accdb" 

If DateDiff("d", DLookup("\[BackupDate\]", "WinAutoBackup", "\[BckID\] 
=1"), Date) = 3 Then

retval = 0
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
retval = objFSO.CopyFile(Source, Target, True)
Set objFSO = Nothing

DoCmd.SetWarnings False
   DoCmd.RunSQL "UPDATE WinAutoBackup SET WinAutoBackup.BackupDate = 
Date();"
DoCmd.SetWarnings True

MsgBox "Backup successfull. Next auto backup in 3 days"

Else
Exit Function
End If

sysBackup_Exit:
Exit Function

sysBackup_Err:
MsgBox Err.Description, , "sysBackup()"
Resume sysBackup_Exit
End Function][1]

Answer 1

从包括以下内容开始：

Option Explicit

在模块顶部。

然后尝试：

Function fMakeBackup() As Boolean

    Dim objFSO As Object

    Dim Source As String
    Dim Target As String
    Dim retval As Integer

    ' Disable error handling during development.
    ' On Error GoTo sysBackup_Err

    Source = CurrentDb.Name

    ' Adjust if if backup folder is not \backups\.
    Target = CurrentProject.Path & "\backups\" 
    Target = Target & Format(Now, "yyyymmdd-hhnn") & ".accdb" 

    ' To run every time, use this line in plade of If DateDiff ...:
    ' If True Then
    If DateDiff("d", DLookup("[BackupDate]", "[WinAutoBackup]", "[BckID] = 1"), Date) >= 3 Then  

        Set objFSO = CreateObject("Scripting.FileSystemObject")
        retval = objFSO.CopyFile(Source, Target, True)
        Set objFSO = Nothing

        DoCmd.SetWarnings False
            DoCmd.RunSQL "UPDATE WinAutoBackup SET WinAutoBackup.BackupDate = Date() WHERE [BckID] = 1;"
        DoCmd.SetWarnings True

        MsgBox "Backup successful. Next auto backup in 3 days."
    End If

sysBackup_Exit:
    Exit Function

sysBackup_Err:
    MsgBox Err.Description, , "sysBackup()"
    Resume sysBackup_Exit

End Function