I think the Compact and Repair process compacts the original database into a
new database, then deletes the original database and renames the new one to
the old one's name.
However, the code that I use for compacting a database renames the original
file to a new name, and compacts the renamed file into a new file that is
given the original file's name. That way, the original is already a backup
copy before the compacting begins.
Public Function
CompactBackendDatabaseFile_Custom(strPathFilename_OriginalBEDB As String, _
strPathFilename_TemporaryBEDB As String) As Integer
' Ken Snell 10 February 2005
' *** THIS FUNCTION IS USED TO COMPACT A DATABASE FILE. THE ORIGINAL FILE IS
COPIED
' *** INTO A TEMPORARY FILE, AND THEN THAT TEMPORARY FILE IS COMPACTED INTO
A FILE
' *** THAT IS GIVEN THE SAME NAME AS THE ORIGINAL FILE NAME. THE FUNCTION
RETURNS A
' *** VALUE OF -1 IF A LOCK FILE EXISTS FOR THE ORIGINAL FILE (NO COMPACTION
DONE); A
' *** VALUE OF 0 IF THE COMPACTION HAD NO ERRORS; A VALUE OF 1 IF THE
FUNCTION CANNOT
' *** FIND THE ORIGINAL FILE; A VALUE OF 2 IF AN ERROR OCCURRED DURING THE
COMPACTION.
Dim intLocation As Integer
Dim strTempBEDB As String, strTemp As String
Dim strDrive As String, strDateTime As String
Const strLockFileExtension As String = "ldb"
On Error Resume Next
strDateTime = Format(Now, "mmmddyyyyhhnnssAmPm")
strTempBEDB = strPathFilename_TemporaryBEDB
intLocation = InStrRev(strTempBEDB, "\")
strTempBEDB = Left(strTempBEDB, intLocation) & strDateTime & _
Mid(strTempBEDB, intLocation + 1)
If Dir(Left(strPathFilename_OriginalBEDB,
Len(strPathFilename_OriginalBEDB) - 3) & _
strLockFileExtension) = "" Then
On Error GoTo Err_Compact_1
Name strPathFilename_OriginalBEDB As strTempBEDB
DoEvents
On Error GoTo Err_Compact_2
DBEngine.CompactDatabase strTempBEDB, strPathFilename_OriginalBEDB
DoEvents
Do Until Dir(strPathFilename_OriginalBEDB) <> ""
Call WasteTime(25)
Loop
On Error Resume Next
' This next line should be commented out if you don't want to delete the
original file
' but want to keep it as a backup -- you can rename the file as desired
Kill strTempBEDB
CompactBackendDatabaseFile_Custom = 0
Else
CompactBackendDatabaseFile_Custom = -1
End If
Exit Function
Err_Compact_1:
On Error Resume Next
MsgBox "The original database file cannot be found at this location:" & _
vbCrLf & " " & strPathFilename_OriginalBEDB & vbCrLf & _
"The file cannot be compacted.", vbExclamation, "Cannot Find The File!"
CompactBackendDatabaseFile_Custom = 1
Exit Function
Err_Compact_2:
On Error Resume Next
Kill strPathFilename_OriginalBEDB
FileCopy strTempBEDB, strPathFilename_OriginalBEDB
MsgBox "An error occurred during the compacting operation of the file!" & _
vbCrLf & _
"The file cannot be compacted.", vbExclamation, "File Compaction Error!"
CompactBackendDatabaseFile_Custom = 2
Exit Function
End Function
