CompactDB Function:
Compact an MS Access database.
Description:
CompactDB Functon will compact your MS Access database.
Using Access databases "holes" are created when records are deleted, making the database fluffy and bloated.
Compacting the database makes it lean and efficient again.
Syntax:
Response.Write CompactDB(DBPath,boolIs97)
Details:
Input arguments:
DBPath:
the full database path and name
eg. "C:\inetpub\wwwroot\mdb-database\mydb.mdb"
boolIs97:
True = Access 97
False = Access 2000+
Example:
<%
Dim DBPath
DBPath = "/mdb-database/mydb.mdb"
DBPath = server.mappath(DBPath)
Response.Write CompactDB(DBPath, False)
%>
ASP Source Code:
<%
Private Function CompactDB(DBPath, boolIs97)
Dim fso, Engine, strDBPath, strProvider
strDBPath = left(DBPath, instrrev(DBPath, "\"))
strProvider = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(strDBPath & "db_temp.mdb") Then
fso.DeleteFile(strDBPath & "db_temp.mdb")
End if
If fso.FileExists(DBPath) Then
On error resume next
Set Engine = CreateObject("JRO.JetEngine")
If boolIs97 = "True" Then
Engine.CompactDatabase strProvider & _
DBPath, strProvider & _
strDBPath & "db_temp.mdb;" & _
"Jet OLEDB:Engine Type=4"
Else
Engine.CompactDatabase strProvider & _
DBPath, strProvider & _
strDBPath & "db_temp.mdb"
End If
fso.CopyFile strDBPath & "db_temp.mdb", DBPath
fso.DeleteFile(strDBPath & "db_temp.mdb")
If Err.number <> 0 Then
CompactDB = "Compact / repair failed, ERROR: " & _
Err.description & _
" - (NOTE: The database dir should have write permissions) "
Else
CompactDB = "Compact/repair of the database """ & _
DBPath & """ completed successfully." & vbCrLf
End if
Set Engine = nothing
On error goto 0
Set fso = nothing
Else
CompactDB = "The database name or path has not been found. Try Again." & vbCrLf
End If
End Function '---CompactDB
%>
| 
