[原创] Access 数据库压缩

If AccessCompact("/data/db1.mdb") = True Then
 Response.Write("Access 数据库压缩成功！！！")
Else
 Response.Write("Access 数据库压缩失败......")
End If

Function AccessCompact(AccessDataPath)
 AccessCompact = True
 'Power by Love_Computer [ QQ 12358163 ]
 'Create by 2005-02-10
 'http://www.56390.com/
 Dim fso, Engine, strAccFullPath,AccFullPath,strTempFile
 On Error Resume Next
 Err = 0
 AccFullPath=Server.MapPath(AccessDataPath)
 strAccFullPath = Left(AccFullPath,InStrRev(AccFullPath,"/"))
 strTempFile = "AccTempData.mdb"
 SET fso = Server.CreateObject("Scripting.FileSystemObject")
 If Err <> 0 Then
  AccessCompact = False
  Err = 0
  Exit Function
 End If
 If fso.FileExists(AccFullPath) = False Then
  AccessCompact = False
  Exit Function
 End If 
 
 SET Engine = CreateObject("JRO.JetEngine")
 If Err <> 0 Then
  AccessCompact = False
  Err = 0
  Exit Function
 End If
 Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AccFullPath," Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strAccFullPath & strTempFile
 fso.CopyFile strAccFullPath & strTempFile,AccFullPath
 fso.DeleteFile(strAccFullPath & strTempFile)
 SET fso = Nothing
 SET Engine = Nothing
 If Err <> 0 Then
  AccessCompact = False
 End If
 Err = 0
End Function