VBA代码调用Access数据库系统压缩和修复数据库功能

如何用VBA代码调用Access系统压缩和修复数据库这一功能.
希望通过标签的单击事件调用系统菜单中的压缩和修复数据库这一功能.

上传个文件：qPdhFMoU.rar

1.  ququ 最简单的办法  新增一个菜单栏，把这个命令拖到菜单内即可

2. kunlun   在Access窗体上创建 建一个标签，在标签的单击事件中添加如下事件

Private Sub Text1_Click() 
    docmd.RunCommand acCmdCompactDatabase
    docmd.RunCommand acCmdRepairDatabase
end sub

3. Tmtony站长做的压缩和修复数据库函数 

Function Compact()  
 With CommandBars.Add(, msoBarFloating, , True)  
 Const CompactId As Long = 2071  
 .Controls.Add msoControlButton, CommandBars("Tools").Controls(7).CommandBar.Controls(2).Id  
 DoEvents  
 .Visible = True  
 .Controls(1).SetFocus  
 SendKeys "{ENTER}" '模拟击键压缩  
 End With  
End Function  

4. 李啸林 修改后的函数

    可以适合97与XP，我没有安装过ACCESS 2000，希望你们能给我补上。  

Dim ref As Reference  
Dim i As Byte  
Set ref = References!Access  
'我不用Application.Vertion是由于，这个属性在Access 97中不存在。  
Select Case ref.Major  
Case 8: i = 6 'Access 97  
Case 9: i = 7 'Access XP  
Case Else  
MsgBox "未知版本,无法使用此功能"  
Exit Sub  
End Select  
With CommandBars.Add(, msoBarFloating, , True)  
  
 .Controls.Add msoControlButton, CommandBars("Tools").Controls(i).CommandBar.Controls(2).Id  
 DoEvents  
 .Visible = True  
 .Controls(1).SetFocus  
 SendKeys "{ENTER}" '模拟击键压缩  
 End With  

5. zhengjialon  把这个函数拷贝下窗体的模块里，然后在标签的单击事件里写：Compact

Function Compact()  
 With CommandBars.Add(, msoBarFloating, , True)  
 Const CompactId As Long = 2071 　　 .Controls.Add msoControlButton, CommandBars("Tools").Controls(7).CommandBar.Controls(2).Id  
 DoEvents  
 .Visible = True  
 .Controls(1).SetFocus  
 SendKeys "{ENTER}" '模拟击键压缩  
 End With  
End Function  

6. guoya ngw123:连接表压缩方法建立一个函数，然后在程序中调用

Function zipDB() 
  
    If Right(CurrentProject.Path, 1) <> "\" Then '判断当前路径 
        Y = CurrentProject.Path & "\" 
    Else 
        Y = CurrentProject.Path 
  End If 
    x = Y & "data_be.mdb"     'data_be.mdb为后台数据库名称 
          '取得路径 
     If Dir(x) = "" Then 
     MsgBox "数据未找到" 
     Exit Function 
     ElseIf Dir(x) <> "" Then '确定文件存在 
       DBEngine.CompactDatabase x, Y & "temp.mdb", ";pwd=123", , ";pwd=123" '压缩为暂存文件 
      ' 假设后台数据库密码为"123"      Kill x '删除原文件 
      FileCopy Y & "temp.mdb", x  '还原 
        Kill Y & "temp.mdb"   '删除暂存文件 
     End If 
  MsgBox "完成修补及压缩" 
End Function

ywg
谢谢huanghai问题解决了,总结一下和各位新手共同学习:

1、用zhengjialon版主提供的Tmtony站长和李啸林的方法,并在VBE的窗口中菜单栏，工具/引用里请首选引用Microsoft Office X.0 Object Llbrary.这种方法应该适用于没有拆分的数据库(拆分后没试过)。2、用guoya的方法适用于拆分过的数据库。 

ywg
版主还是要麻烦你.系统提示错误运行时错误'-2147467259(80004005)':方法'ADD'作用于对象'commandBarControls'时失败

ngw123
连接表如何压缩呀．．怎么没人回答．．．是不是新建一个access实冽，再打开连接表，再压缩．．我去试试．．．

kunlun
这么复杂，有没有简单一点呀。我头都大了，看不懂了

ywg
还有那位能再次拉我一把呀!

zhengjialon
回楼主：在VBE的窗口中菜单栏，工具/引用里请首选引用Microsoft Office X.0 Object Llbrary

huanghai
找到要操作菜单的位置，然后用代码执行，具体如：CommandBars("menu bar").Controls("工具(&T)").Controls("数据库实用工具(&D)").Controls("压缩和修复数据库(&C)...").Execute

ywg在 
huanghai按你所说的方法,系统提示出错,不能压缩打开的数据库.

ywg
guoya你所提供的方法，我经试验发现如果是在没有用户登陆及密码的数据库中可以正常使用，但如果是在有用户登陆及密码的数据库中在压缩后会出现错误提示运行时错误‘3031’密码无效guoya及各位高手能否帮忙解决这个问题。

guoya
后台数据是不应该有安全机制的呀

ywg
没有用系统的安全机制,但有用VBA代码的用户登陆密码,拆分后的后台数据库的密码为123而前台窗体打开时会出现密码无效的错误,应如何解决呢?去掉代码中的pwd=123", , ";pwd=123"可以吗?DBEngine.CompactDatabase x, Y & "temp.mdb", ";pwd=123", , ";pwd=123" '压缩为暂存文件
      ' 假设后台数据库密码为"123"

(设置_安全_修复-相关文章技巧链接)：
ACCESS数据库RunCommand方法参数列表说明说明