Public Sub Compatta(NomeFile As String)
On Error GoTo GestoreErrori
Dim CONN As New JRO.JetEngine
Dim CONN_Sorg As String, CONN_Dest As String

Screen.MousePointer = vbHourglass

CONN_Sorg = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & NomeFile & ";User ID=;Password=;"
CONN_Dest = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\Temp.mdb" & ";Jet OLEDB:Engine Type=5;"
'Compatta il database.
CONN.CompactDatabase CONN_Sorg, CONN_Dest
Set CONN = Nothing

'Copia il file compattato.
Kill NomeFile
FileCopy App.Path & "\Temp.mdb", NomeFile
Kill App.Path & "\Temp.mdb"

Screen.MousePointer = vbNormal
MsgBox "Compattazione del database terminata con successo.", vbInformation, "Informazione"
Exit Sub

GestoreErrori:
Screen.MousePointer = vbNormal
MsgBox "Errore durante il tentativo di compattazione del database: " & Err.Description & ".", vbCritical, "Service"

End Sub