在VB中压缩ACCESS数据库

如果您在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压缩数据库文件

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

以后您在使用Access数据库时可以尝试进行这样的压缩，您应该会发现我说的没有错。