如何用VBA备份和压缩ACCESS数据库？

最新推荐文章于 2021-09-06 11:05:34 发布

原创最新推荐文章于 2021-09-06 11:05:34 发布 · 3.1k 阅读

5 ·

CC 4.0 BY-SA版权

文章标签：

#数据库 #access #vba #string #function #database

VBA程序开发专栏收录该内容

23 篇文章

订阅专栏

本文提供了一个使用VBA实现ACCESS数据库备份与压缩的函数。该函数可在操作成功时返回True，失败时返回False。通过调用此函数，可以实现数据库的压缩或备份，并附带了调用示例。

Q：如何用VBA备份和压缩ACCESS数据库？
A：在有些时候，我们会采用ExcelVBA+ACCESS数据库的方式来制作微型数据库系统。在多次操作数据库后，数据库文件会越变越大。在ACCESS里面有压缩数据库的命令，其实我们完全可以通过Excel VBA来压缩数据库。以下代码就是一个备份和压缩的函数，当操作成功时返回True，失败时返回False。

Public Function CompactAccess(ByVal DataPathName As String, ByVal DatePassWord As String, ByVal BFYS As String) As Boolean Dim objJRO As Object Dim TempData As String Set objJRO = CreateObject("JRO.JetEngine") On Error GoTo ErrHandle TempData = ThisWorkbook.Path & "/数据库_" & BFYS If Dir(TempData) <> vbNullString Then Kill TempData If Len(DataPathName) > 0 Then If BFYS = "压缩" Then If Len(DatePassWord) > 0 Then '数据库有密码的情况 objJRO.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _ & DataPathName & ";Jet OLEDB:Database Password=" _ & DatePassWord, "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " _ & TempData & ";Jet OLEDB:Database Password=" & DatePassWord Else '数据库没有密码的情况 objJRO.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _ & DataPathName, "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & TempData End If Kill DataPathName '删除原文件 Name TempData As DataPathName '重新命名压缩后的文件 Else FileCopy DataPathName, TempData '直接复制备份 End If CompactAccess = True Exit Function End If ErrHandle: CompactAccess = False End Function

参考以下过程来调用该函数进行压缩或备份：

Sub 备份压缩() Dim BFYS$ BFYS = IIf(Application.InputBox("1、备份数据库" & vbCrLf & "2、压缩数据库", , 1, Type:=2) = 1, "备份", "压缩") If CompactAccess(ThisWorkbook.Path & "/数据库.MDB", "", BFYS) Then MsgBox BFYS & "数据库成功" Else MsgBox BFYS & "数据库失败" End If End Sub