模块

Public Sub BackData()
'备份数据
    Dim strdir As String
    Dim strSourceFile As String
    Dim strDestinFile As String
    Dim fs As Object
    Dim strPath As String
    Dim strBkp As String
    Dim intBkp As Integer
    Dim strLowBkp As String

    Set fs = CreateObject("Scripting.FileSystemObject")

    strdir = CurrentProject.path & "\自动备份" 'BackupData备份文件夹保称

    On Error Resume Next
    MkDir strdir
    On Error GoTo 0

    ' 现在查找存在的备份文件 - 只保存最近的 10 个文件
    strBkp = Dir(strdir & "\自动*.mdb")
    Do While Len(strBkp) > 0
        intBkp = intBkp + 1
        If (strBkp < strLowBkp) Or (Len(strLowBkp) = 0) Then
            ' 保存找到的最早的文件名
            strLowBkp = strBkp
        End If
        ' 获取下一个文件
        strBkp = Dir
    Loop
    ' 如果超过 10 个备份文件
    If intBkp > 10 Then
        ' 删除最早的一个
        Kill strdir & "\" & strLowBkp
    End If

    ' 现在,备份一个以今天的日期命名的备份文件
    Dim db As Database
    Dim rs As DAO.Recordset
    Dim sFilename As String
   
    Set db = CurrentDb
    Set rs = db.OpenRecordset("MSysObjects", dbOpenDynaset)
    rs.FindFirst BuildCriteria("Type", dbInteger, "=6")
    sFilename = rs(1)       '获取后端数据库路径和文件名
    Set rs = Nothing
    Set db = Nothing

   strdir = strdir & "\自动" & Format(Now(), "yyyymmdd_hhnnss") & "备份.mdb" '(Date, "yymmdd") & ".bak"
     'strdir = strdir & "\自动" & Format(Date, "yymmdd") & "备份.bak"
    If Dir(strdir) = "" Then
        strSourceFile = sFilename
        strDestinFile = strdir
        fs.CopyFile strSourceFile, strDestinFile

    End If

End Sub

调用：

BackData