CompactDB1

On Error Resume Next
Dim tmpfile$, TheMsg$
Dim Insize&, Outsize&, diff&, Ratio&

AppPath$ = app.Path
If Right$(AppPath$, 1) "\" Then AppPath$ = AppPath$ + "\"
deffile$ = AppPath$ + "DATA.MDB"
cr$ = Chr$(13) + Chr$(10)
screen.MousePointer = 11
tmpfile$ = AppPath$ + "DATA.TMP"
Insize& = FileLen(deffile$)
CompactDatabase deffile$, tmpfile$
If Dir$(tmpfile$) "" Then
Kill deffile$
Name tmpfile$ As deffile$
Else
TheMsg$ = "Error Compressing Database File." + cr$
TheMsg$ = TheMsg$ + "Database file not compressed!"
screen.MousePointer = 0
MsgBox TheMsg$, 48, "Error"
Exit Sub
End If
Outsize& = FileLen(deffile$)
diff& = Insize& - Outsize&
Ratio& = 100 - (100 * (Outsize& / Insize&))
Dim aa As String * 20
TheMsg$ = "Compression complete!" + cr$ + cr$
RSet aa = Format$(Insize&, "##,###,##0")
TheMsg$ = TheMsg$ + "---------------------------------------------------------------------------" + cr$
TheMsg$ = TheMsg$ + "Original File Size (bytes)" + aa + cr$
RSet aa = Format$(Outsize&, "##,###,##0")
TheMsg$ = TheMsg$ + "Compressed File Size (bytes)" + aa & cr$
RSet aa = Format$(diff&, "##,###,##0")
TheMsg$ = TheMsg$ + "---------------------------------------------------------------------------" + cr$
TheMsg$ = TheMsg$ + "File Space Freed Up (bytes)" + aa + cr$ + cr$
RSet aa = Format$(Ratio&, "##,###,##0")
TheMsg$ = TheMsg$ + " Compression Percentage" + aa
screen.MousePointer = 0
MsgBox TheMsg$, 64, "Compression Statistics"
' '**** Repairing database file ****

screen.MousePointer = 11
AppPath$ = app.Path
If Right$(AppPath$, 1) "\" Then AppPath$ = AppPath$ + "\"

RepairDatabase AppPath$ + "DATA.MDB"
screen.MousePointer = 0
MsgBox "Repairs to your Database are Complete.", 64, "Repairs Complete!"