自动备份访问数据库

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

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

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返回数据库的使用位置。