VB 實作 Access 資料庫壓縮修復：CompactJetDatabase 完整範例

為何需要壓縮 Access 資料庫？

Access 資料庫在刪除資料或物件後會產生碎片，導致檔案體積持續膨脹且磁碟空間使用效率下降。壓縮修復的本質是複製檔案並重新組織磁碟存儲結構，可顯著提升效能。注意事項：

• Access 專案（ADP）的壓縮不影響 SQL Server 端的資料庫物件
• 若已從資料表尾端刪除記錄，壓縮會重設自動編號種子值

核心程式碼：CompactJetDatabase 程序

以下模組程式碼提供完整壓縮邏輯，包含可選的備份功能。實測可將 21.6 MB 資料庫壓縮至 300 KB。

宣告與常數

Option Explicit

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
    (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Const MAX_PATH = 260

主要壓縮程序

Public Sub CompactJetDatabase(Location As String, Optional BackupOriginal As Boolean = True)
    On Error GoTo CompactErr
    Dim strBackupFile As String, strTempFile As String

    ' 確認檔案存在
    If Len(Dir(Location)) = 0 Then Exit Sub

    ' 選擇性備份原始檔
    If BackupOriginal 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

CompactErr:
    Exit Sub
End Sub

取得暫存路徑輔助函式

Public Function GetTemporaryPath() As String
    Dim strFolder As String, 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 資料庫精簡高效。部署前請先測試備份邏輯，確保資料安全。