自动备份访问数据库

Question

我有这段代码，我从某个地方得到（感谢作者）并进行了一些修改，以便每 7 天自动备份一次我的数据库。

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 = "d:\" 
    Target = Target & Format(Date, "mm-dd-yyyy") & "  " 
    Target = Target & Format(Time, "hh-mm") & ".accdb" 

  If DateDiff("d", DLookup("[BackupDate]", "WinAutoBackup", "[BckID] =1"), Date) = 7 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 7 days"

  Else
    Exit Function
  End If
  
sysBackup_Exit:
Exit Function

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

如何修改路径，以便所有备份文件都进入名为备份的文件夹中 与主后端数据库文件相同的目录？

Answer 1

替换

Target = "d:\"
Target = Target & Format(Date, "mm-dd-yyyy") & "  " 
Target = Target & Format(Time, "hh-mm") & ".accdb" 

f:\databasefolder 是保存后端数据库文件的驱动器/文件夹：

Target = "f:\databasefolder\backups\" 
Target = Target & Format(Now, "yyyymmdd-hhnn") & ".accdb"

Answer 2

使用 CurrentProject.path 返回使用数据库的位置。