PROCEDURE QUI VOUS PERMET DE COMPACTER VOTRE BD

Dim Fichier As New FileSystemObject
Dim BaseCompactée As String
On Error GoTo erreure
Me.MousePointer = 11
If Dir(App.Path & "\mabase.ldb") <> "" Then
    BD.Close
End If
If Dir(App.Path & "\mabase.mdb") <> "" Then
    Avant = FileLen(App.Path & "\mabase.mdb")
    BaseCompactée = App.Path & "\mabase.bak"
    If Fichier.FileExists(BaseCompactée) Then
        Fichier.DeleteFile BaseCompactée
    End If
    DBEngine.CompactDatabase App.Path & "\mabase.mdb", BaseCompactée
    Fichier.CopyFile BaseCompactée, App.Path & "\mabase.mdb"
    Fichier.DeleteFile BaseCompactée
Else
    Me.MousePointer = 0
    MsgBox Path & "mabase.mdb non trouvé" & vbCrLf & "Compactage de la Db non effectué"
    Exit Sub
End If
Me.MousePointer = 0
FrmAceuil.msg1.MsgBoxEx "Taille initiale: " & Avant / 1024 & " Kb" & vbCrLf & "Apres Compactage: " & FileLen(App.Path & "\mabase.mdb") / 1024 _
& " Kb" & vbCrLf & "Gain: " & (Avant - FileLen(App.Path & "\mabase.mdb")) / 1024 & " Kb ou " & Avant - FileLen(App.Path & "\mabase.mdb") & " Octects", vbInformation, "Compactage"
Exit Sub
erreure:
Me.MousePointer = 0
MsgBox "Vous avez essayé de compacter des enregistrements déjà ouverts" & vbNewLine & "Recommencez lorsque vos enregistrements seront disponibles", vbCritical, "Erreure survenue"
Exit Sub