如果您在Access数据库、Access项目中删除数据或对象，可能会产生碎片并导致磁盘空间使用效率的降低。同时，数据库文件的大小并未减小，而是不断的增大，直至您的硬盘没有空间。有没有好的处理方法呢？其实，在Access中可以对数据库进行压缩优化以提升Access数据库和Access项目的性能，这样的压缩处理的实质是复制该文件，并重新组织文件在磁盘上的存储方式。但是，在Access项目中进行这样的压缩不会影响到数据库对象（例如表或视图），因为它们是存储在Microsoft SQL Server数据库中而不是在Access项目本身中。同样，这样的压缩也不会影响到Access项目中的自动编号。在Access数据库中，如果已经从表的末尾删除了记录，压缩该数据库是就会重新设置自动编号值。添加的下一个记录的自动编号值将会比表中没有删除的最后记录的自动编号值大一。

下面介绍如何在VB中用一个CompactJetDatabase过程实现对Access数据库文件的压缩处理，在这个过程中有一个可选参数，就是在压缩前你是否需要把原有的数据库文件备份到临时目录（True或False）。我用此办法使21.6MB的数据库压缩到仅仅300KB。

这些代码可放在模块中，在其他窗体也使用

Public Declare Function GetTempPath Lib "kernel32" Alias _ 

"GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long 

Public Const MAX_PATH = 260 

Public Sub CompactJetDatabase(Location As String, Optional BackupOriginal As Boolean = True) 

On Error GoTo CompactErr 

Dim strBackupFile As String 

Dim strTempFile As String 

检查数据库文件是否存在

If Len(Dir(Location)) Then 

如果需要备份就执行备份

If BackupOriginal = True Then 

strBackupFile = GetTemporaryPath & "backup.mdb" 

If Len(Dir(strBackupFile)) Then Kill strBackupFile 

FileCopy Location, strBackupFile 

End If 

创建临时文件名

strTempFile = GetTemporaryPath & "temp.mdb" 

If Len(Dir(strTempFile)) Then Kill strTempFile 

DBEngine.CompactDatabase Location, strTempFile 

Kill Location 

FileCopy strTempFile, Location 

Kill strTempFile 

Else 

End If 

CompactErr: 

Exit Sub 

End Sub 

Public Function GetTemporaryPath() 

Dim strFolder As String 

Dim lngResult As Long 

strFolder = String(MAX_PATH, 0) 

lngResult = GetTempPath(MAX_PATH, strFolder) 

If lngResult <> 0 Then 

GetTemporaryPath = Left(strFolder, InStr(strFolder, Chr(0)) - 1) 

Else 

GetTemporaryPath = "" 

End If 

End Function