怎样来用vb实现数据备份？

Question

引用Microsoft Scripting Runtime

Answer 1

Filecopy aaa.mdb a:\aaa.mdb 注意第二个文件名请不要省略

Answer 2

'送给你了，这是把整个目录备份的
Private Sub CommBackup_Click()Dim fso As New FileSystemObject    Call ProgressBarTime
    
    aPath = Dir1.Path & "\database"
    If Not fso.FolderExists(aPath) Then
        fso.CreateFolder (aPath)
    End If
    
    fso.CopyFolder App.Path & "\database", aPath
    
    sysmsgData.Recordset.Edit
        sysmsgData.Recordset("备份时间") = Format(Now, "yyyy年mm月dd日 hh:mm:ss")
        sysmsgData.Recordset("备份路径") = aPath
    sysmsgData.Recordset.Update
        
    Call ProgressBarTime
End Sub

Answer 3

Filecopy "aaa.mdb","a:\aaa.mdb" 注意第二个文件名请不要省略和文件大小

Answer 4

下面的语句压缩数据库并产生一个数据库备份：
DBEngine.CompactDatabase “C:\VB\BIBLIO.MDB”, “C:\VB\BIBLIO2.MDB”
   Kill “C:\VB\BIBLIO.BAK”   Name “C:\VB\BIBLIO.MDB” As “C:\VB\BIBLIO.BAK”
   Name “C:\VB\BIBLIO2.MDB” As “C:\VB\BIBLIO.MDB”

Answer 5

Private Sub Save()
    
    '备份数据库
    On Error Resume Next
    Dim strDBName1 As String
    Dim db1 As Database
    Dim strDB1 As String
    Dim workDB As Database
    Dim qdf As QueryDef
    Dim qdf1 As QueryDef    CommonDialog1.Filter = "Access Database (*.MDB)|*.mdb"
    CommonDialog1.ShowSave
    
    If Len(CommonDialog1.FileName) > 0 Then
        strDBName1 = CommonDialog1.FileName
    If InStr(strDBName1, ".") = 0 Then
        strDBName1 = strDBName1 & ".mdb"
    End If
    
   
    If Dir(strDBName1) <> vbNullString Then
       If MsgBox(strDBName1 & "已经存在，要替换该文件吗？", vbQuestion + vbYesNo, "提示") = vbYes Then
           Kill strDBName1
       Else
         Exit Sub
       End If
    End If
    Else
        Exit Sub
    End If
    
    If Len(strDBName1) = 0 Then
        Exit Sub
    End If
    
    Set db1 = CreateDatabase(strDBName1, dbLangGeneral)
    
    db1.Close
    Set db1 = Nothing    If Right$(Trim$(App.Path), 1) = "\" Then
        Set workDB = OpenDatabase(App.Path & "\data\txl.mdb")
    Else
        Set workDB = OpenDatabase(App.Path & "\data\txl.mdb")
    End If
    
    strDB1 = "select xytxl.* into xytxl in '" & strDBName1 & " 'from xytxl"
    
    Set qdf = workDB.CreateQueryDef("user_qdf", strDB1)
    
    If Err.Number = 424 Then
        workDB.QueryDefs.Delete "user_qdf"
        Set qdf = workDB.CreateQueryDef("user_qdf", strDB1)
    End If
    
    qdf.Execute
    workDB.QueryDefs.Delete "user_qdf"
    strDB1 = "select passwordtable.* into passwordtable in '" & strDBName1 & " ' from passwordtable"
    Set qdf = workDB.CreateQueryDef("user_qdf", strDB1)
    
    If Err.Number = 424 Then
        workDB.QueryDefs.Delete "user_qdf"
        Set qdf = workDB.CreateQueryDef("user_qdf", strDB1)
    End If
   
    qdf.Execute
    workDB.QueryDefs.Delete "user_qdf"
    
    qdf1.Execute
    workDB.QueryDefs.Delete "user_qdf"
    strDB1 = "select passkey.* into passkey in '" & strDBName1 & " ' from passkey"
    Set qdf1 = workDB.CreateQueryDef("user_qdf", strDB1)
    
    If Err.Number = 424 Then
        workDB.QueryDefs.Delete "user_qdf"
        Set qdf1 = workDB.CreateQueryDef("user_qdf", strDB1)
    End If
   
    qdf1.Execute
    workDB.QueryDefs.Delete "user_qdf"
    
    
     ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    '给备份数据库创建索引
    Dim DB12 As Database
    Set DB12 = OpenDatabase(strDBName1)
    DB12.Execute "CREATE INDEX 姓名 ON xytxl" & "(姓名);"
    DB12.Close
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Set qdf = Nothing
    workDB.Close
    Set workDB = Nothing
    
    MsgBox "数据库已经成功备份", vbInformation, "提示"
    
End Sub本代码在win98,win2000+vb6下测试通过