Procedure qui vous permet de compacter votre bd

Soyez le premier à donner votre avis sur cette source.

Snippet vu 5 253 fois - Téléchargée 33 fois

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

Ajouter un commentaire

Commentaires

veloce35
Messages postés
27
Date d'inscription
jeudi 2 octobre 2003
Statut
Membre
Dernière intervention
18 avril 2010

Bonjour moulkafadnene
Bon source, je l'ai utiliser pour compte personnel.
Cordialement
cs_ITALIA
Messages postés
2169
Date d'inscription
vendredi 20 avril 2001
Statut
Membre
Dernière intervention
30 juin 2009
8
J'ai déja Posté une Source Qui fait la même Chose et Permet aussi de la Réparer !!

http://www.vbfrance.com/code.aspx?id=25682

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.