Sub CompactRepair()
Dim ReplaceDB As String 'true or false
Dim PathtoDB As String 'path to database
Dim ProjectDB As String 'name of database
Dim CompactDB As String 'name of compacted database
'create a clone database and compact that one. Leaves the original database alone
If ReplaceDB = False Then
Try
Dim JRO As JRO.JetEngine
JRO = New JRO.JetEngine()
JRO.CompactDatabase( _
"Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & PathtoDB & ProjectDB, _
"Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & PathtoDB & CompactDB _
& ";Jet OLEDB:Engine Type=5"
MsgBox("Database succesfully compacted and repaired!" & (Chr(10)) & _
" " & (Chr(10)) & _
"The existing database has remained intact, the" & (Chr(10)) & _
"compacted and repaired database has been saved " & (Chr(10)) & _
"as:" & (Chr(10)) & _
" " & (Chr(10)) & _
PathtoDB & CompactDB, MsgBoxStyle.OKOnly, "Compact and Repair"
Catch ex As Exception
MsgBox("Error: " & ex.Source & ": " & ex.Message & (Chr(10)) & _
" " & (Chr(10)) & _
"Delete the following file and try again: " & (Chr(10)) & _
" " & (Chr(10)) & _
PathtoDB & CompactDB & (Chr(10)) & _
" " & (Chr(10)) & _
"Or change the Compact and Repair settings in the Prefernces dialogue.", MsgBoxStyle.OKOnly, "Compact and Repair"

End Try
'compacts the original database after first making a copy
ElseIf ReplaceDB = True Then
Try
'Archive the projects database in case of error
FileCopy(PathtoDB & ProjectDB, PathtoDB & ProjectDB & ".ARCHIVED - " & Common.MonthShort)
'rename db before compact
Try
MkDir("C:\pst-temp"

Catch
RmDir("C:\pst-temp"

MkDir("C:\pst-temp"

End Try
Rename(PathtoDB & ProjectDB, "C:\pst-temp\tmp.mdb"
'compact and repair db
Dim JRO As JRO.JetEngine
JRO = New JRO.JetEngine()
JRO.CompactDatabase( _
"Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=C:\pst-temp\tmp.mdb", _
"Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & PathtoDB & ProjectDB _
& ";Jet OLEDB:Engine Type=5"
'tidy up files
Kill("C:\pst-temp\tmp.mdb"

RmDir("C:\pst-temp\"
MsgBox("Database succesfully compacted and repaired!", MsgBoxStyle.OKOnly, "Compact and Repair"
Catch ex As Exception
MsgBox("Error: " & ex.Source & ": " & ex.Message, MsgBoxStyle.OKOnly, "Compact and Repair"

End Try
End If
End Sub