非常简单的问题，我知道。
答案 0 :(得分：29)
如果要压缩/修复外部mdb文件（不是刚刚使用的那个）：
Application.compactRepair sourecFile, destinationFile
如果要压缩您正在使用的数据库：
Application.SetOption "Auto compact", True
在最后一种情况下，关闭文件时您的应用程序将被压缩。
我的观点：在一个额外的MDB“compacter”文件中编写几行代码，当你想压缩/修复mdb文件时可以调用它是非常有用的：在大多数情况下，需要压缩的文件不能是正常打开，所以你需要从文件外部调用方法。
否则，在Access应用程序的每个主模块中，默认情况下autocompact应设置为true。
如果发生灾难，请创建新的mdb文件并从错误文件中导入所有对象。您通常会找到一个无法导入的错误对象（表单，模块等）。
答案 1 :(得分：2)
尝试添加此模块，非常简单，只需启动Access，打开数据库，将“Compact on Close”选项设置为“True”，然后退出。
自动压缩语法：
acCompactRepair "C:\Folder\Database.accdb", True
要返回默认值*：
acCompactRepair "C:\Folder\Database.accdb", False
*没有必要，但是如果你的后端数据库是> 1GB，当你直接进入它时这可能会很烦人，并且需要2分钟才能退出！
编辑：添加了递归所有文件夹的选项，我每晚运行以将数据库降至最低。
'accCompactRepair
'v2.02 2013-11-28 17:25
'===========================================================================
' HELP CONTACT
'===========================================================================
' Code is provided without warranty and can be stolen and amended as required.
' Tom Parish
' TJP@tomparish.me.uk
' http://baldywrittencod.blogspot.com/2013/10/vba-modules-access-compact-repair.html
' DGF Help Contact: see BPMHelpContact module
'=========================================================================
'includes code from
'http://www.ammara.com/access_image_faq/recursive_folder_search.html
'tweaked slightly for improved error handling
' v2.02 bugfix preventing Compact when bAutoCompact set to False
' bugfix with "OLE waiting for another application" msgbox
' added "MB" to start & end sizes of message box at end
' v2.01 added size reduction to message box
' v2.00 added recurse
' v1.00 original version
Option Explicit
Function accSweepForDatabases(ByVal strFolder As String, Optional ByVal bIncludeSubfolders As Boolean = True _
, Optional bAutoCompact As Boolean = False) As String
'v2.02 2013-11-28 17:25
'sweeps path for .accdb and .mdb files, compacts and repairs all that it finds
'NB: leaves AutoCompact on Close as False unless specified, then leaves as True
'syntax:
' accSweepForDatabases "path", [False], [True]
'code for ActiveX CommandButton on sheet module named "admin" with two named ranges "vPath" and "vRecurse":
' accSweepForDatabases admin.Range("vPath"), admin.Range("vRecurse") [, admin.Range("vLeaveAutoCompact")]
Application.DisplayAlerts = False
Dim colFiles As New Collection, vFile As Variant, i As Integer, j As Integer, sFails As String, t As Single
Dim SizeBefore As Long, SizeAfter As Long
t = Timer
RecursiveDir colFiles, strFolder, "*.accdb", True 'comment this out if you only have Access 2003 installed
RecursiveDir colFiles, strFolder, "*.mdb", True
For Each vFile In colFiles
'Debug.Print vFile
SizeBefore = SizeBefore + (FileLen(vFile) / 1048576)
On Error GoTo CompactFailed
If InStr(vFile, "Geographical Configuration.accdb") > 0 Then MsgBox "yes"
acCompactRepair vFile, bAutoCompact
i = i + 1 'counts successes
GoTo NextCompact
CompactFailed:
On Error GoTo 0
j = j + 1 'counts failures
sFails = sFails & vFile & vbLf 'records failure
NextCompact:
On Error GoTo 0
SizeAfter = SizeAfter + (FileLen(vFile) / 1048576)
Next vFile
Application.DisplayAlerts = True
'display message box, mark end of process
accSweepForDatabases = i & " databases compacted successfully, taking " & CInt(Timer - t) & " seconds, and reducing storage overheads by " & Int(SizeBefore - SizeAfter) & "MB" & vbLf & vbLf & "Size Before: " & Int(SizeBefore) & "MB" & vbLf & "Size After: " & Int(SizeAfter) & "MB"
If j > 0 Then accSweepForDatabases = accSweepForDatabases & vbLf & j & " failures:" & vbLf & vbLf & sFails
MsgBox accSweepForDatabases, vbInformation, "accSweepForDatabases"
End Function
Function acCompactRepair(ByVal pthfn As String, Optional doEnable As Boolean = True) As Boolean
'v2.02 2013-11-28 16:22
'if doEnable = True will compact and repair pthfn
'if doEnable = False will then disable auto compact on pthfn
On Error GoTo CompactFailed
Dim A As Object
Set A = CreateObject("Access.Application")
With A
.OpenCurrentDatabase pthfn
.SetOption "Auto compact", True
.CloseCurrentDatabase
If doEnable = False Then
.OpenCurrentDatabase pthfn
.SetOption "Auto compact", doEnable
End If
.Quit
End With
Set A = Nothing
acCompactRepair = True
Exit Function
CompactFailed:
End Function
'source: http://www.ammara.com/access_image_faq/recursive_folder_search.html
'tweaked slightly for error handling
Private Function RecursiveDir(colFiles As Collection, _
strFolder As String, _
strFileSpec As String, _
bIncludeSubfolders As Boolean)
Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant
'Add files in strFolder matching strFileSpec to colFiles
strFolder = TrailingSlash(strFolder)
On Error Resume Next
strTemp = ""
strTemp = Dir(strFolder & strFileSpec)
On Error GoTo 0
Do While strTemp <> vbNullString
colFiles.Add strFolder & strTemp
strTemp = Dir
Loop
If bIncludeSubfolders Then
'Fill colFolders with list of subdirectories of strFolder
On Error Resume Next
strTemp = ""
strTemp = Dir(strFolder, vbDirectory)
On Error GoTo 0
Do While strTemp <> vbNullString
If (strTemp <> ".") And (strTemp <> "..") Then
If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
colFolders.Add strTemp
End If
End If
strTemp = Dir
Loop
'Call RecursiveDir for each subfolder in colFolders
For Each vFolderName In colFolders
Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
Next vFolderName
End If
End Function
Private Function TrailingSlash(strFolder As String) As String
If Len(strFolder) > 0 Then
If Right(strFolder, 1) = "\" Then
TrailingSlash = strFolder
Else
TrailingSlash = strFolder & "\"
End If
End If
End Function
答案 2 :(得分：2)
对于Access 2013，您可以这样做
Sendkeys "%fic"
这与在键盘上输入ALT，F，I，C相同。
对于不同版本，它可能是不同的字母序列，但“％”符号表示“ALT”，因此请将其保留在代码中。您可能只需要更改字母，具体取决于按ALT时显示的字母
答案 3 :(得分：1)
是的，这很简单。
Sub CompactRepair()
Dim control As Office.CommandBarControl
Set control = CommandBars.FindControl( Id:=2071 )
control.accDoDefaultAction
End Sub
基本上它只是找到“压缩和修复”菜单项并以编程方式点击它。
答案 4 :(得分：1)
当用户退出FE尝试重命名后端MDB时，最好使用yyyy-mm-dd格式的名称中的今天日期。确保在执行此操作之前关闭所有绑定的表单，包括隐藏的表单和报表。如果你收到错误信息，哎呀，它忙着所以不要打扰。如果成功则将其压缩。
有关详细信息，请参阅我的Backup, do you trust the users or sysadmins?提示页。
答案 5 :(得分：1)
如果您的数据库有前端和后端。您可以在前端主导航表单的主窗体上使用以下代码：
Dim sDataFile As String, sDataFileTemp As String, sDataFileBackup As String
Dim s1 As Long, s2 As Long
sDataFile = "C:\MyDataFile.mdb"
sDataFileTemp = "C:\MyDataFileTemp.mdb"
sDataFileBackup = "C:\MyDataFile Backup " & Format(Now, "YYYY-MM-DD HHMMSS") & ".mdb"
DoCmd.Hourglass True
'get file size before compact
Open sDataFile For Binary As #1
s1 = LOF(1)
Close #1
'backup data file
FileCopy sDataFile, sDataFileBackup
'only proceed if data file exists
If Dir(sDataFileBackup vbNormal) <> "" Then
'compact data file to temp file
On Error Resume Next
Kill sDataFileTemp
On Error GoTo 0
DBEngine.CompactDatabase sDataFile, sDataFileTemp
If Dir(sDataFileTemp, vbNormal) <> "" Then
'delete old data file data file
Kill sDataFile
'copy temp file to data file
FileCopy sDataFileTemp, sDataFile
'get file size after compact
Open sDataFile For Binary As #1
s2 = LOF(1)
Close #1
DoCmd.Hourglass False
MsgBox "Compact complete " & vbCrLf & vbCrLf _
& "Size before: " & Round(s1 / 1024 / 1024, 2) & "Mb" & vbCrLf _
& "Size after: " & Round(s2 / 1024 / 1024, 2) & "Mb", vbInformation
Else
DoCmd.Hourglass False
MsgBox "ERROR: Unable to compact data file"
End If
Else
DoCmd.Hourglass False
MsgBox "ERROR: Unable to backup data file"
End If
DoCmd.Hourglass False
答案 6 :(得分：1)
试试这个。它适用于代码所在的同一数据库。只需调用下面显示的CompactDB（）函数即可。确保在添加该功能后，在第一次运行之前单击VBA编辑器窗口中的“保存”按钮。我只在Access 2010中进行过测试.Ba-da-bing，ba-da-boom。
Public Function CompactDB()
Dim strWindowTitle As String
On Error GoTo err_Handler
strWindowTitle = Application.Name & " - " & Left(Application.CurrentProject.Name, Len(Application.CurrentProject.Name) - 4)
strTempDir = Environ("Temp")
strScriptPath = strTempDir & "\compact.vbs"
strCmd = "wscript " & """" & strScriptPath & """"
Open strScriptPath For Output As #1
Print #1, "Set WshShell = WScript.CreateObject(""WScript.Shell"")"
Print #1, "WScript.Sleep 1000"
Print #1, "WshShell.AppActivate " & """" & strWindowTitle & """"
Print #1, "WScript.Sleep 500"
Print #1, "WshShell.SendKeys ""%yc"""
Close #1
Shell strCmd, vbHide
Exit Function
err_Handler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Close #1
End Function
答案 7 :(得分：1)
还要注意上面 CompactDB() 代码中的另一个缺陷。
如果定义了数据库的“AppTitle”属性（就像在数据库属性中定义“应用程序标题”时发生的那样），这会使显示的“默认窗口标题”逻辑无效，这可能导致脚本失败，或者“行为不可预测”。因此，添加代码来检查 AppTitle 属性 - 或使用 API 调用从 Application.hWndAccessApp 窗口读取窗口标题文本都可能更加可靠。
此外，在 Access 2019 中，我们观察到：
SendKeys "multi-key-string-here"
...也可能无法可靠地工作，需要替换为：
SendKey (single-character)
'put a DoEvents or Sleep 150 here
SendKey (single-character)
'put a DoEvents or Sleep 150 here
SendKey (single-character)
'put a DoEvents or Sleep 150 here
SendKey (single-character)
...从 Access UI 获得正确响应。
答案 8 :(得分：0)
我在2003年或者可能是97岁时做了这么多，哎呀！
如果我记得你需要使用上面绑定到计时器的一个子命令。 您无法在任何连接或表单打开的情况下对数据库进行操作。
所以你要关闭所有表单，然后将计时器作为最后一个运行方法启动。 （一旦一切都关闭，它将依次调用紧凑的操作）
如果你没有想到这一点，我可以挖掘我的档案并把它拉起来。
答案 9 :(得分：0)
DBEngine.CompactDatabase source，dest
答案 10 :(得分：0)
Application.SetOption＆＃34; Auto compact＆＃34;，False＆＃39;（如上所述） 使用按钮标题：＆＃34; DB Not Compact On Close＆＃34;
编写代码以使用＆＃34; DB Compact On Close＆＃34;切换标题。 以及Application.SetOption＆＃34; Auto compact＆＃34;，True
AutoCompact可以通过按钮或代码设置，例如：导入大型临时表后。
启动表单可以包含关闭Auto Compact的代码，因此它不会每次都运行。
这样，您就不会试图与Access进行对抗。
答案 11 :(得分：0)
如果您不希望在关闭时使用compact（例如，因为前端mdb是一个连续运行的机器人程序），并且您不想仅为压缩创建单独的mdb，请考虑使用cmd文件。
我让我的robot.mdb检查自己的大小：
FileLen(CurrentDb.Name))
如果它的大小超过1 GB，它会创建一个像这样的cmd文件......
Dim f As Integer
Dim Folder As String
Dim Access As String
'select Access in the correct PF directory (my robot.mdb runs in 32-bit MSAccess, on 32-bit and 64-bit machines)
If Dir("C:\Program Files (x86)\Microsoft Office\Office\MSACCESS.EXE") > "" Then
Access = """C:\Program Files (x86)\Microsoft Office\Office\MSACCESS.EXE"""
Else
Access = """C:\Program Files\Microsoft Office\Office\MSACCESS.EXE"""
End If
Folder = ExtractFileDir(CurrentDb.Name)
f = FreeFile
Open Folder & "comrep.cmd" For Output As f
'wait until robot.mdb closes (ldb file is gone), then compact robot.mdb
Print #f, ":checkldb1"
Print #f, "if exist " & Folder & "robot.ldb goto checkldb1"
Print #f, Access & " " & Folder & "robot.mdb /compact"
'wait until the robot mdb closes, then start it
Print #f, ":checkldb2"
Print #f, "if exist " & Folder & "robot.ldb goto checkldb2"
Print #f, Access & " " & Folder & "robot.mdb"
Close f
...启动cmd文件......
Shell ExtractFileDir(CurrentDb.Name) & "comrep.cmd"
......然后关闭......
DoCmd.Quit
接下来，cmd文件压缩并重新启动robot.mdb。
答案 12 :(得分：-1)
查看此解决方案VBA Compact Current Database。
基本上它说这应该有效
Public Sub CompactDB()
CommandBars("Menu Bar").Controls("Tools").Controls ("Database utilities"). _
Controls("Compact and repair database...").accDoDefaultAction
End Sub
答案 13 :(得分：-1)
还有Michael Kaplan的SOON ("Shut One, Open New") add-in。你必须链接它，但这是一种方法。
我不能说我有太多理由想要以编程方式执行此操作，因为我正在为最终用户编程，并且他们从不使用任何东西，除了Access用户界面中的前端，并且没有有理由定期压缩设计合理的前端。