作者：绿色风
分类：
时间：2022-08-17
浏览：81
楼主
amulee |
Q：如何用VBA备份和压缩ACCESS数据库？
A：在有些时候，我们会采用ExcelVBA+ACCESS数据库的方式来制作微型数据库系统。在多次操作数据库后，数据库文件会越变越大。在ACCESS里面有压缩数据库的命令，其实我们完全可以通过Excel VBA来压缩数据库。以下代码就是一个备份和压缩的函数，当操作成功时返回True，失败时返回False。
- Public Function CompactData(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
- CompactData = True
- Exit Function
- End If
- ErrHandle:
- CompactData = False
- End Function
参考以下过程来调用该函数进行压缩或备份：
- Sub 备份压缩()
- Dim BFYS$
- BFYS = IIf(Application.InputBox("1、备份数据库" & vbCrLf & "2、压缩数据库", , 1, Type:=2) = 1, "备份", "压缩")
- If CompactData(ThisWorkbook.Path & "\数据库.MDB", "", BFYS) Then
- MsgBox BFYS & "数据库成功"
- Else
- MsgBox BFYS & "数据库失败"
- End If
- End Sub
 压缩备份数据库.rar
|
2楼
bobbyhust |
学习了 谢谢大侠 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一