在Access数据库操作时经常数据库经常会由于操作频繁而出现各种问题.以及数据库无限的增大.为了不影响使用我们需要对数据库进行压缩/修复.以下代码就是用VB压缩并且修复Access数据库德 代码.大家可以直接使用. 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 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