[原創] 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