Compacter ou comprimer une bd d'access

Commenter

Contenu du snippet

La Base de Donné ne peux pas s'auto-compacter avec une macro ou via une commande VB (sauf en pasant par une reference DAO et par microsoft scripting runtime)
L'idée est d'utiliser une deuxieme base de donné que j'ai appelé "CompactBD", avec dans celle ci un formulaire et une table.

Source / Exemple : 


A mettre dans le formulaire de la base de donné "CompactBD" dans l'execution d'un bouton clic (Comprimer par exemple)

Private Sub Comando2_Click()
On Error GoTo Err_Comando2_Click

    Dim dbs As Database, tbl As TableDef, fld As Field
    Dim Archivo_Comp, Archivo_bak

    Set dbs = CurrentDb()
    Set tbl = dbs.TableDefs![Camino_DB]
    Set fld = tbl![Path]
    Docmd.Minimize
    Archivo_Comp = fld.DefaultValue
    If MsgBox("Voulez vous comprimer ce fichier: " & Archivo_Comp, vbYesNo + vbExclamation, Title:="Cuidado") = vbYes Then
    Archivo_bak = Archivo_Comp & ".bak"
    FileCopy Archivo_Comp, Archivo_bak
    MsgBox "Un fichier de backup à ete créé: " & Archivo_bak, Title:="Informacíon", Buttons:=vbInformation

    
    If Dir("BDTemp.mdb") <> "" Then Kill "BDTemp.mdb"
    DBEngine.CompactDatabase Archivo_Comp, "BDTemp.mdb"
    FileCopy "BDTemp.mdb", Archivo_Comp
    If Dir("BDTemp.mdb") <> "" Then Kill "BDTemp.mdb"
    End If
    Docmd.Close
    Application.Quit acPrompt
    
Err_Comando2_Click:
    MsgBox Err.Description
    Resume Exit_Comando2_Click
    
End Sub

A mettre dans un module dans la BD à compacter

Function Compactar_BD()
Dim dbs As DATABASE, tbl As TableDef, fld As Field
Dim txt1, txt2, txt3, temp As String
'Dim c1, c2, c3 As Integer (y en a plus besoin 23-03-02)

Set dbs = CurrentDb()
Set tbl = dbs.TableDefs![Camino_DB]
Set fld = tbl.Fields![Path] ' recupere le chemin
txt1 = dbs.Name
fld.DefaultValue = txt1 ' place le chemin de la BD actuelle dans le champs Path de la table Camino_DB

' corrigé le 18-11-01

txt2 = Dir(txt1)
txt3 = Left$(txt1, Len(txt1) - Len(txt2))
txt3 = txt3 & "CompactDB.mdb" ' ajoute chemin a la BD CompactDB.mdb

If dir(txt3) <> "" Then ' ne pas mettre "CompactDB.mdb"  si non le message d'erreur n'est pas le perso
Docmd.SetWarnings False
Docmd.CopyObject txt3, "Camino_DB", acTable, "Camino_DB" ' copie la table Camino_DB dans la BD CompactDB.mdb
Docmd.SetWarnings True
temp = ShellExecute(0, "open", txt3, "", "", 1)
CloseCurrentDatabase
Else
MsgBox "Il manque le fichier CompactDB.mdb dans le repertoire: " & txt2 & "  Pas d'acces possible à la fonction.", vbCritical

End If

End Function

' corrigé le 23/03/02
A mettre dans un module separé (Func_Shell par ex)

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Conclusion :


Completé le 23-03-02
Il faut créer une BD "CompactBD", avec un formulaire qui s'ouvre en auto. La table sera créé automatiquement avec le module.

Dans la base donnée à comprimer, il faut créer une table intitulée "Camino_DB" avec un champs texte de au moins 150 caracteres intitulé "Path"

Si je n'ai rien oublié en appelant la fonction le chemin de la BD à comprimer passe dans la table de la BD "CompactBD", La BD à compacter se ferme la BD CompactBD s'ouvre et vous permet à l'aide du formulaire de comprimer la BD. Elle fait un backup du fichier avant de la comprimer(on ne sait jamais).
J'ai ajouté la fonction Func_Shell (Dans un module)

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 (Remiguel)