Procedure qui vous permet de compacter votre bd

Commenter

Contenu du snippet

avant tous pour que cette procedure march bien ajouter le DLL suivant Projet >>> references >>>> "Microsoft Scripting Runtime"

Source / Exemple : 


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

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (moulkafadnene)