怎样实现对数据的备份和恢复！急，在线等待！

怎样实现对数据的备份和恢复！急，在线等待！
操作系统为winme，b6.0，单机版，数据库为access格式！
怎么实现对数据库的备份和恢复！急！高分送！

解决方案 »

  1.   

    直接对access数据库文件进行复制即可。
      

  2.   

    Private Sub Command1_Click()
     Me.MousePointer = 11
     Label1 = "整理数据库 ..."
     Command1.Visible = False
     drvDrives.Visible = False
     Me.dirDirs.Visible = False
     Me.MousePointer = 11
     Me.Refresh
     Me.Tag = "BACKUPED"
     On Error Resume Next
     MyVAl.rs.Close
     MyVAl.Con.Close
     If Dir("TEMP.MDB") = "" Then
        FileCopy MyVAl.DBFile, "temp.mdb"
     End If
     If Dir("TEMP.MDB") = "" Then
      MsgBox "有其他用户或进程正在使用该系统数据库", vbCritical, Me.Caption
      Unload Me
      Exit Sub
     End If
     On Error GoTo UnloadMe
     
     Me.MousePointer = 0
     
     Label1.Caption = "压缩数据 ..."
     Me.Refresh
     Me.Enabled = False
     If UCase(drvDrives.Drive) < "C" Then
      FloppyBackup
     Else
      HddBackup
     End If
     Kill "temp.MDB"
     End
     Exit Sub
    UnloadMe:
     MsgBox Error, vbOKOnly, Me.Caption
     Unload Me
    End SubPrivate Sub drvDrives_Change()
      If UCase(drvDrives.Drive) < "C" Then
        dirDirs.Visible = False
        Exit Sub
      End If
      dirDirs.Visible = True
      Err.Clear
      On Error Resume Next
      dirDirs.path = Me.drvDrives.Drive
      If Err <> 0 Then
       MsgBox Error, vbCritical + vbOKOnly, Me.Caption
      End If
    End SubPrivate Sub Combo1_Click()
      Err.Clear
      On Error Resume Next
      dirDirs.path = Combo1.Text
      If Err <> 0 Then
       MsgBox Error, vbCritical + vbOKOnly, Me.Caption
      End If
    End Sub
    Private Sub Form_activate()
    Dim i As Integer
    ChDrive MyVAl.DBPath
    ChDir MyVAl.DBPath
    BackupFile = MyVAl.DBName
     
     Label1 = "选择备份路径"
     Me.drvDrives.Visible = True
     Me.dirDirs.Visible = True
     Command1.Visible = True
     
    End Sub
    Private Sub FloppyBackup()
     Dim ActivedhWnd As Long, TaskID As Long, i As Integer, n As Integer, a As String
     Dim DirName As String, Target As String, lExit As Long
     Me.MousePointer = 11
     On Error Resume Next
     Kill BackupFile & ".B??"
     TaskID = Shell("arj a -v1440k -y " & BackupFile & ".B01 " & "temp.mdb", 0)
     If TaskID = 0 Then
       MsgBox "arj程序丢失", vbCritical + vbOKOnly, Me.Caption
       Unload Me
       Exit Sub
     End If
     
     ActivedhWnd = OpenProcess(&H400, False, TaskID)
        Do
            GetExitCodeProcess ActivedhWnd, lExit
            DoEvents
        Loop While lExit = &H103
     
    ' ActivedhWnd = OpenProcess(&H400, False, TaskID)        'gwh改进
    '    Do While ActivedhWnd <> 0
    '        DoEvents
    '        ActivedhWnd = OpenProcess(&H400, False, TaskID)
    '    Loop
    '    SendMessage ActivedhWnd, &H10, 0, 0
    '    DoEvents
     
    ' ActivedhWnd = FindArjWindow()
    ' Do While ActivedhWnd = FindArjWindow() And ActivedhWnd <> 0
    '   DoEvents
    ' Loop
    ' SendMessage ActivedhWnd, &H10, 0, 0
    ' DoEvents
    Target = Me.drvDrives.Drive
    DirName = Dir(BackupFile & ".B??")
    Me.Animation1.Stop
     Label1.Visible = False
     Me.Refresh
     On Error GoTo Error_L
     Do While DirName <> ""
      n = n + 1
      DirName = Dir
     Loop
     Label1.Refresh
     For i = 1 To n
      a = BackupFile & ".B" & Format(i, "00")
      If MsgBox("请插入软盘制作备份盘#" & i & "/" & n & " !", vbOKCancel, Me.Caption) = vbOK Then
        Do
         DirName = Dir(Target & "*.*")
         If DirName <> "" Then
          If MsgBox("该软盘片有数据，请插入格式化过的空白盘!", vbOKCancel, Me.Caption) = vbCancel Then
           Kill BackupFile & ".B??"
           Unload Me
           Exit Sub
          End If
         End If
        Loop While DirName <> ""
        Label1.Visible = True
        Label1.Caption = "正在备份到" & Target & " ..."
        Label1.Refresh
        OpenAvi Animation1, "MOVE", False
        Animation1.Play
         FileCopy a, Target & "\" & a
         Open Target & "\" & n & ".dsk" For Output As #1
         Close #1
       Animation1.Stop
       Animation1.Visible = False
       Label1.Visible = False
      Else
       Exit For
      End If
     Next
    Kill BackupFile & ".B??"
    MsgBox "备份完成！", vbOKOnly, Me.Caption
    Me.MousePointer = 0
    Exit Sub
    Error_L:
     If MsgBox(Error, 50, Me.Caption) = 3 Then
        Unload Me
        Exit Sub
     Else
        Resume
     End If
    End SubPrivate Sub HddBackup()
     Dim ActivedhWnd As Long, TaskID As Long, i As Integer, n As Integer, a As String
     Dim DirName As String, Target As String, lExit As Long
     Me.MousePointer = 11
     On Error Resume Next
     Kill BackupFile & ".BBB"
     TaskID = Shell("arj a -y " & BackupFile & ".BBB " & "temp.mdb", 0)
     If TaskID = 0 Then
       MsgBox "arj程序丢失", vbCritical + vbOKOnly, Me.Caption
       Unload Me
       Exit Sub
     End If
     
     ActivedhWnd = OpenProcess(&H400, False, TaskID)
        Do
            GetExitCodeProcess ActivedhWnd, lExit
            DoEvents
        Loop While lExit = &H103
     
    ' ActivedhWnd = OpenProcess(&H400, False, TaskID)
    '    Do While ActivedhWnd <> 0
    '        DoEvents
    '        ActivedhWnd = OpenProcess(&H400, False, TaskID)
    '    Loop
    '    SendMessage ActivedhWnd, &H10, 0, 0
    '    DoEvents
    '
    ' ActivedhWnd = FindArjWindow()
    ' Do While ActivedhWnd = FindArjWindow() And ActivedhWnd <> 0
    '   DoEvents
    ' Loop
    ' SendMessage ActivedhWnd, &H10, 0, 0
    ' DoEventsTarget = dirDirs.List(dirDirs.ListIndex)
    If Right(Target, 1) = "\" Then
      Target = Left(Target, Len(Target) - 1)
    End If
    DirName = Dir(BackupFile & ".BBB")
    Me.Animation1.Stop
    Label1.Visible = False
    Me.Refresh
    On Error GoTo Error_L
    Label1.Refresh
    Label1.Visible = True
    Label1.Caption = "正在备份到" & Target & " ..."
    Label1.Refresh
    OpenAvi Animation1, "MOVE", False
    Animation1.Play
    Err.Clear
    On Error Resume Next
    FileCopy BackupFile & ".BBB", Target & "\" & BackupFile & ".BBB"
    Animation1.Stop
    Animation1.Visible = False
    Label1.Visible = False
    If Err = 0 Then
     Kill BackupFile & ".BBB"
    End If
    MsgBox "备份完成！", vbOKOnly, Me.Caption
    Me.MousePointer = 0
    Exit Sub
    Error_L:
     If MsgBox(Error, 50, Me.Caption) = 3 Then
        Unload Me
        Exit Sub
     Else
        Resume
     End If
    End SubPrivate Sub Form_Load()
    Dim s As String, i As Integer
    UnloadAllChildWindow Me.Name
    End SubPrivate Sub Form_Unload(Cancel As Integer)
     On Error Resume Next
     Kill "temp.mdb"
    End Sub
      

  3.   

    Option Explicit
    Dim BackupFile As StringPrivate Sub CopyFloppyBack()
    Dim i As Integer
    Dim Errmsg As String
    Dim BakList As String, sDrive As String
    Dim sTo As String
    Dim ActivedhWnd As Long, TaskID As Long, lExit As Long
    Dim iFileSum As Integer
    On Error GoTo Error_L
       Drive1.Visible = False
       dirDirs.Visible = False
       sTo = CurDir()   sDrive = Drive1.Drive
       If InStr(sDrive, "[") > 0 Then
          sDrive = Left(sDrive, 2)
       End If
       sDrive = sDrive + "\"
       
       BakList = Dir(sDrive & "*.dsk")
       Do While BakList = ""
          If MsgBox("请在" + sDrive + "中插入第1张备份盘！", vbOKCancel, "数据恢复") = vbCancel Then
            Exit Sub
          End If
          BakList = Dir(sDrive & "*.dsk")
       Loop
       iFileSum = Val(BakList)
       Me.MousePointer = 11
       
       For i = 1 To iFileSum
          BakList = sDrive + BackupFile + ".B" + Format(i, "00")
          BakList = Dir(BakList)
          Do While BakList = ""
            If MsgBox("请在" + sDrive + "中插入第" + Trim(Str(i)) + "张备份盘！", vbOKCancel, "数据备份") = vbCancel Then
              Exit For
            End If
            BakList = sDrive + BackupFile + ".B" + Format(i, "00")
            BakList = Dir(BakList)
          Loop
          Label1.Caption = "共计" + Trim(iFileSum) + "张盘，正在恢复第" + Trim(Str(i)) + "张盘...."
          Label3 = "从" + sDrive + "到" + sTo + "..."
          Animation1.Visible = True
          Me.Animation1.Play
          FileCopy sDrive + BakList, BakList
          Me.Animation1.Stop
          Animation1.Visible = False
          Label3.Caption = ""
       Next i
       i = i - 1
       Me.MousePointer = 0
       If i < iFileSum Then
          MsgBox "备份盘读入失败，只读入了" + Trim(Str(i)) + "张软盘", 64, ""
       Else
          Me.MousePointer = 11
          CmdStare.Enabled = False
          cmdClear.Enabled = False
          Animation1.Visible = True
          Animation1.Play
          Label1.Caption = "请稍候，正在释放数据库......"
          TaskID = Shell("arj e -y " + BackupFile + ".B* ", 0)
          If TaskID = 0 Then
            MsgBox "arj程序丢失", vbCritical + vbOKOnly, Me.Caption
            Unload Me
            Exit Sub
          End If
          
          ActivedhWnd = OpenProcess(&H400, False, TaskID)
        Do
            GetExitCodeProcess ActivedhWnd, lExit
            DoEvents
        Loop While lExit = &H103
          
    '    ActivedhWnd = OpenProcess(&H400, False, TaskID)        'gwh改进
    '    Do While ActivedhWnd <> 0
    '        DoEvents
    '        ActivedhWnd = OpenProcess(&H400, False, TaskID)
    '    Loop
    '    SendMessage ActivedhWnd, &H10, 0, 0
    '    DoEvents
     
          
    '        ActivedhWnd = FindArjWindow()
    '        Do While ActivedhWnd = FindArjWindow() And ActivedhWnd <> 0
    '          DoEvents
    '        Loop
    '        SendMessage ActivedhWnd, &H10, 0, 0
    '        DoEvents
            
          Drive1.Visible = False
          Label1 = "备份数据：时间" & FileDateTime("temp.mdb") & "，大小：" & FileLen("temp.mdb")
          Label2.Visible = True
          Label2.Left = Label1.Left
          Label2 = "当前数据：时间" & FileDateTime(BackupFile & ".mdb") & "，大小：" & FileLen(BackupFile & ".mdb")
          Me.MousePointer = 0
          CmdStare.Enabled = True
          CmdStare.Caption = "使用备份"
          cmdClear.Enabled = True
          Me.Animation1.Stop
          Animation1.Visible = False
       End If
    Exit Sub
    Error_L:
    Select Case Err
     Case 71:
      Errmsg = "未检查到软盘!"
     Case 61:
      Errmsg = "剩余空间不够!"
     Case 53:
      Errmsg = "这不是第" + Trim(Str(i)) + "张备份盘,请另换一张!"
     Case Else:
      Errmsg = Error
    End Select
    Me.Animation1.Stop
    If MsgBox(Errmsg, vbRetryCancel, "出错信息") = vbCancel Then
        Me.MousePointer = 0
        Animation1.Visible = False
        cmdClear.Enabled = True
        Unload Me
        Exit Sub
    Else
        BakList = BackupFile + ".B" + Format(i, "00")
        Animation1.Visible = True
        Me.Animation1.Play
        Resume
    End If
    End Sub
    Private Sub CopyHddBack()
    Dim i As Integer
    Dim Errmsg As String
    Dim BakList As String, sFile As String
    Dim sTo As String
    Dim ActivedhWnd As Long, TaskID As Long, lExit As Long
    On Error GoTo Error_L
       Drive1.Visible = False
       dirDirs.Visible = False
       sTo = CurDir()
       
       If Right(dirDirs.List(dirDirs.ListIndex), 1) <> "\" Then
         sFile = dirDirs.List(dirDirs.ListIndex) & "\" & BackupFile & ".BBB"
       Else
         sFile = dirDirs.List(dirDirs.ListIndex) & BackupFile & ".BBB"
       End If
       
       BakList = Dir(sFile)
       If BakList = "" Then
           MsgBox "未发现备份文件！", vbOKOnly + vbExclamation, "数据恢复"
           Unload Me
           Exit Sub
       End If
       
          Me.MousePointer = 11
          CmdStare.Enabled = False
          cmdClear.Enabled = False
          Animation1.Visible = True
          Animation1.Play
          Label1.Caption = "请稍候，正在释放数据库......"
          TaskID = Shell("arj e -y " & Chr(34) & sFile & Chr(34), 0)
          If TaskID = 0 Then
            MsgBox "arj程序丢失", vbCritical + vbOKOnly, Me.Caption
            Unload Me
            Exit Sub
          End If
          
          ActivedhWnd = OpenProcess(&H400, False, TaskID)
        Do
            GetExitCodeProcess ActivedhWnd, lExit
            DoEvents
        Loop While lExit = &H103
          
    '      ActivedhWnd = OpenProcess(&H400, False, TaskID)        'gwh改进
    '    Do While ActivedhWnd <> 0
    '        DoEvents
    '        ActivedhWnd = OpenProcess(&H400, False, TaskID)
    '    Loop
    '    SendMessage ActivedhWnd, &H10, 0, 0
    '    DoEvents
     
    '        ActivedhWnd = FindArjWindow()
    '        Do While ActivedhWnd = FindArjWindow() And ActivedhWnd <> 0
    '          DoEvents
    '        Loop
    '        SendMessage ActivedhWnd, &H10, 0, 0
    '        DoEvents
            
            
          Drive1.Visible = False
          Label1 = "备份数据：时间" & FileDateTime("temp.mdb") & "，大小：" & FileLen("temp.mdb")
          Label2.Visible = True
          Label2.Left = Label1.Left
          Label2 = "当前数据：时间" & FileDateTime(BackupFile & ".mdb") & "，大小：" & FileLen(BackupFile & ".mdb")
          Me.MousePointer = 0
          CmdStare.Enabled = True
          CmdStare.Caption = "使用备份"
          cmdClear.Enabled = True
          Me.Animation1.Stop
          Animation1.Visible = False
    Exit Sub
    Error_L:
    Select Case Err
     Case 71:
      Errmsg = "未检查到软盘!"
     Case 61:
      Errmsg = "剩余空间不够!"
     Case 53:
      Errmsg = "这不是第" + Trim(Str(i)) + "张备份盘,请另换一张!"
     Case Else:
      Errmsg = Error
    End Select
    Me.Animation1.Stop
    If MsgBox(Errmsg, vbRetryCancel, "出错信息") = vbCancel Then
        Me.MousePointer = 0
        Animation1.Visible = False
        cmdClear.Enabled = True
        Unload Me
        Exit Sub
    Else
        Animation1.Visible = True
        Me.Animation1.Play
        Resume
    End IfEnd Sub
    Private Sub CmdClear_Click()
      Unload Me
    End SubPrivate Sub CmdStare_Click()
      Dim Target As String, ReEnter As Boolean
      Picture1.Visible = False
      ReEnter = False
      If Drive1.Visible Then
       Me.Enabled = False
       If UCase(Drive1.Drive) < "C" Then
          CopyFloppyBack
       Else
          CopyHddBack
       End If
       Me.Enabled = True
      Else
         Me.MousePointer = 11
         CmdStare.Enabled = False
         cmdClear.Enabled = False
         Label1.Caption = "正在更新数据库......"
         Label2.Visible = False
         Animation1.Visible = True
         Me.Animation1.Play
         On Error Resume Next
         MyVAl.rs.Close
         MyVAl.Con.Close
         On Error GoTo 0
         FileCopy "temp.mdb", BackupFile & ".mdb"
         Animation1.Visible = False
         Me.Animation1.Stop
         ReEnter = True
      End If
      If ReEnter Then
        Dim op As Recordset, id As Long
         Me.MousePointer = 0
         MsgBox "数据恢复成功！请重新进入系统", 64, "数据恢复"
         Unload Me
         End
      End If
      Exit Sub
    ErrorMsg:
      MsgBox Error & vbCrLf & GetOdbcErrors, vbCritical, Caption
      ExecRs "USE " & MyVAl.DBName
      Unload Me
    End Sub
      

  4.   

    打开我的电脑，找到access在硬盘上的地址，COPY，再粘贴到其他位置。OK。
      

  5.   

    备份数据库：filecopy "c:\mdb\db1.mdb","c:\db1.bak"
      

  6.   

    Private Sub Command1_Click()
    On Error Resume Next
       Dim strdbname As String
       Dim strdbn As String
       Dim db As Database
       Dim strdb As String
       Dim workdb As Database
       Dim qdf As QueryDef   CommonDialog1.Filter = "Access Database (*.MDB)|*.mdb"
       CommonDialog1.ShowOpen
       If Len(CommonDialog1.FileName) > 0 Then
          strdbname = CommonDialog1.FileName
          If InStr(strdbname, ".") = 0 Then
             strdbname = strdbname & ".mdb"
          End If
       Else
          Exit Sub
       End If   If Right$(Trim$(App.Path), 1) = "\" Then
          strdbn = App.Path & "data1.mdb"
       Else
          strdbn = App.Path & "\data1.mdb"
       End If
          
       FileCopy strdbname, strdbn   MsgBox "数据库已经成功还原！", 48, "提示"
    End Sub 这样的代码是我做的还原数据。
    但是运行的时候出现说，缺少库。
    但是在一个新的工程中能运行，不知道是怎么了？急！
      

  7.   

    同意zsgzsgzsg(zsg) ( ) 的办法！方法简单易懂！我有sql 的备份和还原！
    '*********************************************************
    '* 名称：BackupDatabase
    '* 功能：备份数据库
    '* 控件：一个文本框和两个按钮（备份到和确定）
    '*********************************************************
    Public Sub BackupDatabase()
    Dim cn As New ADODB.Connection
    Dim s_path, s_dataexport As String
    s_path = App.Path
    Me.MousePointer = 11   '设置鼠标指针形状
    'student1是需要备份的数据库名称
    s_dataexport = "backup database student1 to disk='" + CommonDialog1.FileName + "'"
    cn.Open "driver={sql server};server=" & d1 & ";database=student1;persist security info=false; userid=sa"  '数据库连接字符串
    '这里不需要连接master数据库，即可完成备份
    cn.BeginTrans
    cn.Execute s_dataexport
    Err.Number = 0
    If Err.Number = 0 Then
        cn.CommitTrans
        MsgBox "数据备份成功！", vbInformation, "提示"
        MsgBox "数据备份文件存放路径:" & CommonDialog1.FileName, vbOKOnly, "提示"
        Unload Me
    Else
        cn.RollbackTrans
        MsgBox "数据备份失败！请检查数据库是否正在打开！", vbCritical, "提示"
    End If
    cn.Close
    Set cn = Nothing
    Me.MousePointer = 1
    End Sub'*********************************************************
    '* 名称：RestoreDataBase
    '* 功能：还原数据库
    '* 控件：一个文本框和两个按钮（ 打开和确定）
    '*********************************************************
    Public Sub RestoreDataBase()
    If Text1.Text = "" Then
        MsgBox "请选择要恢复的数据文件！", vbInformation, "提示"
        Exit Sub
    Else
        ret = MsgBox("数据恢复操作将会覆盖以前的所有数据并且覆盖后无法恢复，您确定要进行恢复操作吗？", vbQuestion + vbOKCancel, "提示")
        If ret = vbOK Then
           Dim cn As New ADODB.Connection
           Dim sn As New ADODB.Recordset
           Dim s_restore As String
           Me.MousePointer = 11
           cn.Open "Provider=SQLOLEDB.1;Persist Security Info=False;server=" & d1 & ";Initial Catalog=master;Data Source=127.0.0.1;user id=sa;password=" & d3 & ""
           sn.Open "select  spid  from  sysprocesses  where  dbid=db_id('student1')", cn
            Do While Not sn.EOF
              cn.Execute "kill " & sn("spid")
              sn.MoveNext
            Loop
            sn.Close
            s_restore = "restore database student1 from disk='" + Trim(Text1.Text) + "'  with REPLACE"
            cn.Execute s_restore
             'Debug.Print gs_conn_string
             '此时需要连接master数据库才能完成数据恢复操作
             '同上student1为需要恢复的数据库
            s_restore = "restore database student1 from disk='" + Trim(Text1.Text) + "'"
             'text1一个用于记录需要恢复文件的地址的textbox
            cn.Execute s_restore
            cn.BeginTrans
            If Err.Number = 0 Then
                cn.CommitTrans
                MsgBox "数据恢复成功！", vbInformation, "提示"
                Command1.Enabled = True
                Label1.Visible = False
            Else
                cn.RollbackTrans
                MsgBox "数据恢复失败！", vbCritical, "提示"
                Command1.Enabled = True
            End If
            cn.Close
            Set cn = Nothing
            Me.MousePointer = 1
        Else
            Exit Sub
        End If