压缩/修复 Access数据库操作 (VB/ASP)

在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