Option Explicit
Dim DatanameBak     As String

Sub Systembak()
    If Dir(Text1(0).Text) = "" Then
         mDB.Close
         FileCopy sDatabase, Text1(0).Text
         MsgBox "备份成功!", vbYes, "系统提示"
         mDB.Open
    Else
        If MsgBox("您要保存的文件已存在，需要覆盖它吗？", vbYesNo, "系统提示") = vbYes Then
            mDB.Close
            FileCopy sDatabase, Text1(0).Text
            MsgBox "备份成功!", vbYes, "系统提示"
            mDB.Open
        End If
    End If
End Sub

Private Sub Command1_Click(Index As Integer)
   Select Case Index
    Case 0 'backup
        Systembak
        Unload Me
    Case 3 'cancel
        Unload Me
    Case 1 'unbackup
        If MsgBox("请问您已经确定您想要恢复的文件是当前显示的文件吗？,如果是，请您按备份按钮", vbYesNo, "系统提示，请您确定") = vbYes Then
           UnsystemBak
        Else
           MsgBox "备份失败，请您重新备份!"
        End If
    Case 2 'open
        CommonDialog1.FileName = Text1(0).Text
        CommonDialog1.ShowOpen
        Text1(0).Text = CommonDialog1.FileName
    Case 4 '
        Text1(0).Text = GetSetting(App.Title, "Setup", "Backupdir", App.Path & "\Databak") & "\" & Format(Now, "YYYYMMDD") & ".mdb"
    Case 5
        SaveSetting App.Title, "Setup", "Backupdir", GetFilepath(Text1(0).Text)
    End Select
End Sub

Private Sub Form_Load()
    On Error GoTo ErrExit
    Text1(0).Text = GetSetting(App.Title, "Setup", "Backupdir", App.Path & "\Databak") & "\" & Format(Now, "YYYYMMDD") & ".mdb"
    If Dir(App.Path & "\databak", vbDirectory) = "" Then MkDir App.Path & "\databak"
    'Command1(1).Enabled = IsSystem
ErrExit:
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
    If Index = 1 Then
       If KeyAscii = 13 Then Command1(0).SetFocus
    End If
End Sub

Sub UnsystemBak()
    On Error GoTo ErrExit
    If Dir(Text1(0).Text) <> "" Then
        mDB.Close
        FileCopy Text1(0).Text, sDatabase
        mDB.Open
        MsgBox "数据还原成功!", vbYes, "系统提示"
    Else
        MsgBox "您想要恢复的文件不存在，请您重新选择", vbInformation, "系统提示"
    End If
ErrExit:
End Sub

Function GetFilepath(FileName As String)
    Dim I As Integer
    GetFilepath = FileName
    For I = Len(FileName) To 1 Step -1
        If Mid(FileName, I, 1) = "\" Then
            GetFilepath = Left(FileName, I - 1)
            Exit For
        End If
    Next I
End Function

这是VB的代码希望你能参考