[原创] Access 数据库压缩

来源：互联网发布：信息安全检测软件编辑：程序博客网时间：2024/05/16 09:46

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