%
sub compact_access_db()
on error resume next
'Dimension variables
dim objJetEngine 'Holds the jet database engine object
dim objFSO 'Holds the FSO object
dim strCompactDB 'Holds the destination of the compacted database
dim strDbPathAndName
dim strCon
'Create an intence of the FSO object
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
strDbPathAndName = server.MapPath("../../../member/" & Request.Cookies("storename") & "/db/dbStore.mdb")
'Back up the database
objFSO.CopyFile strDbPathAndName, Replace(strDbPathAndName, ".mdb", "-backup.mdb", 1, -1, 1)
'Response.Write("
Database backed up to:-
" & Replace(strDbPathAndName, ".mdb", "-backup.mdb", 1, -1, 1) & "
")
'Create an intence of the JET engine object
Set objJetEngine = Server.CreateObject("JRO.JetEngine")
'Get the destination and name of the compacted database
strCompactDB = Replace(strDbPathAndName, ".mdb", "-tmp.mdb", 1, -1, 1)
'Compact database
strCon = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strDbPathAndName 'This one is for Access 2000/2002
objJetEngine.CompactDatabase strCon, "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & strCompactDB
'Display text that new compact db is created
'Response.Write(" New compacted database:-
" & strCompactDB & "
")
'Release Jet object
Set objJetEngine = Nothing
'Delete old database
objFSO.DeleteFile strDbPathAndName
'Display text that that old db is deleted
'Response.Write(" Old uncompacted database deleted:-
" & strDbPathAndName & "
")
'Rename temporary database to old name
objFSO.MoveFile strCompactDB, strDbPathAndName
'Delete backup database
objFSO.DeleteFile strCompactDB
'Display text that that old db is deleted
'Response.Write(" Rename compacted database from:-
" & strCompactDB & "
To:-
" & strDbPathAndName & "
")
'Release FSO object
Set objFSO = Nothing
Response.Write(" The Forums Access database is now compacted and repaired")
end sub
%>