请问如何利用VB做ACCESS的备份

解决方案 »

  1.   

    Option ExplicitPublic Const FO_MOVE = &H1
    Public Const FO_COPY = &H2
    Public Const FO_DELETE = &H3
    Public Const FOF_NOCONFIRMATION = &H10
    Public Const FOF_NOCONFIRMMKDIR = &H200
    Public Const FOF_ALLOWUNDO = &H40
    Public Const FOF_SILENT = &H4'自定义数据类型,API调用时的参数
    Public Type SHFILEOPSTRUCT
        hWnd       As Long
        wFunc      As Long
        pFrom      As String
        pTo        As String
        fFlags     As Integer
        fAborted   As Boolean
        hNameMaps  As Long
        sProgress  As String
    End TypePublic Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long'**过程名:Compress_MDB
    '**功能描述:数据库压缩(.mdb)
    '**输    入:
    '**输    出:
    '**全局变量:
    '**调用模块:Microsoft  DAO 3.6
    '**作    者:
    '**日    期:2003年12月7日
    '*************************************************************************
    Public Sub Compress_MDB() '数据库压缩
    On Error GoTo Compress_MDB_ErrorHandler
    Screen.MousePointer = 11
        
        Dim oldMdb As String                '待压缩数据库文件名
        Dim newMdb As String                '压缩后的数据库文件名
        
        oldMdb = App.Path & "\test4.mdb"
        newMdb = App.Path & "\test4_temp.mdb"
        
        DBEngine.CompactDatabase oldMdb, newMdb, , , ""
        DoEvents    '考虑到连接是网络中的数据库时
        
        Kill oldMdb          '删除原来的文件
        
        Name newMdb As oldMdb   '将压缩后的数据库文件名称改回去
        
        Screen.MousePointer = 0
        MsgBox "数据压缩成功!", vbInformation, "提示!"
        
    ErrorHandler:
        Exit Sub
    Compress_MDB_ErrorHandler:
        Screen.MousePointer = 0
        MsgBox Err.Description
        Resume ErrorHandler
    End Sub
      

  2.   

    '**过程名: Backup_MDB
    '**功能描述:数据库备份(.mdb)
    '**输    入:
    '**输    出:
    '**全局变量:
    '**调用模块:API SHFileOperation
    '**作    者:
    '**日    期:2003年12月7日
    '*************************************************************************
    Public Sub Backup_MDB() '备份数据库
    On Error GoTo Backup_MDB_ErrorHandler
    Screen.MousePointer = 11    On Error Resume Next
        
        Dim SHFileOp As SHFILEOPSTRUCT
        
        SHFileOp.wFunc = FO_COPY
        SHFileOp.pFrom = App.Path & "\test4.mdb"
        SHFileOp.pTo = App.Path & "\back\test4.mdb"
        SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR
        Call SHFileOperation(SHFileOp)
        DoEvents    '考虑到连接是网络中的数据库时
        Screen.MousePointer = 0
        MsgBox "数据备份成功!", vbInformation, "提示!"ErrorHandler:
        Exit Sub
    Backup_MDB_ErrorHandler:
        Screen.MousePointer = 0
        MsgBox Err.Description
        Resume ErrorHandler
    End Sub'**过程名: Reset_MBD
    '**功能描述:复原库备份(.mdb)
    '**输    入:
    '**输    出:
    '**全局变量:
    '**调用模块:API SHFileOperation
    '**作    者:
    '**日    期:2003年12月7日
    '*************************************************************************
    Public Sub Reset_MBD() '复原数据库
    On Error GoTo Reset_MBD_ErrorHandler
    Screen.MousePointer = 11
        
        Dim oldMdb As String                '待压缩数据库文件名
        Dim newMdb As String                '压缩后的数据库文件名
        Dim SHFileOp As SHFILEOPSTRUCT
        SHFileOp.wFunc = FO_COPY
        SHFileOp.pFrom = App.Path & "\back\test4.mdb"
        SHFileOp.pTo = App.Path & "\test4.mdb"
        SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR
        Call SHFileOperation(SHFileOp)
        DoEvents    '考虑到连接是网络中的数据库时
        Screen.MousePointer = 0
        MsgBox "数据库复原成功!", vbInformation, "提示!"ErrorHandler:
        Exit Sub
    Reset_MBD_ErrorHandler:
        Screen.MousePointer = 0
        MsgBox Err.Description
        Resume ErrorHandler
    End Sub
      

  3.   

    不会吧??  楼主!本身就是一个帖子,重复粘贴一下代码,居然比原作者给的分好高????搞错了吧?晕ing
      

  4.   

    回复人: passer_wave(路人) ( ) 信誉:98  2004-04-13 11:55:00  得分:0 
     
     
      不会吧??  楼主!本身就是一个帖子,重复粘贴一下代码,居然比原作者给的分好高????搞错了吧?晕ing
      
     
    Top 
     
     回复人: daisy8675(莫依) ( ) 信誉:100  2004-04-13 18:47:00  得分:0 
     
     
      倒
      
     
    Top 
     
     该问题已经结贴 ,得分记录: swed (10)、 swed (10)、 passer_wave (10)、 passer_wave (10)、 vbsbird (10)、 668 (50)、  /////////////這張貼子真奇觀