COMPACTER ET OUVRIR UNE BASE DE DONNÉES ACCESS 2002 AVEC MOT DE PASSE

' Ajouter dans une form un bouton

Private Sub Command1_Click()
    dim strCheminSourceDeVotreBd as string
    dim strMotPasse as string

    ' Chemin pour accèder a votre base de données
    strCheminSourceDeVotreBd = App.PAth + "MaBd.mdb"

    ' Entrer votre mot de passe
    strMotPasse = "xxxx"

    If True = CompactBd(strCheminSourceDeVotreBd, strMotPasse) Then
        MsgBox "Compression complété.", vbInformation, "Compression de la base de données"
        ' Recreer la connection à la BD
        call ConnectionBd(strCheminSourceDeVotreBd,strMotPasse)
    Else
        MsgBox "Erreur dans la compression.", vbCritical, "Compression de la base de données"
    End If
End Sub


' Dans un module

Public GCNNBASE As New ADODB.Connection ' Connection à la base de données


' Procédure pour se connecter à votre base
Public Sub ConnectionBD(strCheminSourceDeVotreBd as string,strMotPAsse as string)
   
    on error goto GestionErreur

    GCNNBASE.Provider = "Microsoft.jet.oledb.4.0;Jet OLEDB:Database Password=" & 
                                         strMotPAsse

    GCNNBASE.ConnectionString = strCheminSourceDeVotreBd
    GCNNBASE.Open

GestionErreur:
       msgbox"Erreur dans la connection",vbinformation
end sub

' Function pour compacter la base
Public Function CompactBd(strCheminBd As String, strMotPasse As String) As Boolean
    
    On Error GoTo GestionErreur
    
    Dim jro As jro.JetEngine
    Dim strTempBd As String
    
    ' Regarde si la connection à la Bd est ouverte
    If GCNNBASE.State = 1 Then GCNNBASE.Close
    
    strTempBd = App.Path & "\Temp.mdb"
    
    Set jro = New jro.JetEngine
    
    ' Compacter le Bd source dans la Bd Temporaire (strTempBd)
    jro.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strCheminBd & ";Jet OLEDB:Database Password=" & strMotPasse, _
    "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strTempBd & ";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Password=" & strMotPasse
                        
    ' Effacer la base de donnée source
    Kill strCheminBd
    
    ' Renomme la Bd Temporaire pour votre nom de bd
    Name strTempBd As strCheminBd
    
    CompactBd = True
    
    Exit Function

GestionErreur:
     CompactBd = False
End Function