Discussion :

[mihego32]

Salut,

Je bute sur un problème de tables attachées d'une base MDB protégée par un mot de passe. J'ai cherché sur l'Internet mais en vain donc je me tourne vers vous et votre expérience.

Parmi mes applications, j'en ai avec une base Access unique et d'autres où j'utilise le principe de séparation de la Base Programme (PROG) et des Bases des Données (DATA). Dans le premier cas, j'ai par exemple une application avec laquelle je gère mes codes d'accès bancaires, Internet, etc ; cette base unique, Programme & Données, est protégée par un mot de passe et cela fonctionne à mon entière satisfaction : une boîte de dialogue me demande d'entrer mon mot de passe. Dans le second cas, j'ai une Base PROG spécifique à chaque application (Budget, Journal, Achats etc) et qui peut être reliée à plusieurs Bases DATA, chacune avec son contenu particulier.

Par exemple, j'ai une base PROG "TIPS" avec laquelle je gère une série d'informations et de trucs utiles dans un domaine. Chaque domaine a sa base DATA propre, comme "msOffice", "OS", "Scooters", "Jobs", "Santé" etc. En pratique, lorsque je lance la base PROG, elle conserve la base DATA précédemment utilisée et le menu principal permet de choisir un autre domaine à traiter avec sa base DATA. Une fois le choix fait, les liens avec les tables attachées sont actualisés avec la nouvelle base DATA. Et cela fonctionne très bien...

Jusqu'à ce que je décide de créer un domaine que je veux garder confidentiel : "Privé" avec sa base DATA à protéger par un mot de passe et là c'est le blocage. Ma Sub AttachTables(DB_name As String) - voir ci-dessous - bloque sur le premier td.Connect = newPath (ligne 22) avec un message d'erreur et sans la moindre boîte de dialogue de saisie du mot de passe.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub AttachTables(DB_name As String)   ' 15/06/2007
' Allows to refresh attached tables links to 1 single DB
' with its full name and path given in DB_name.
' These full name and path come from the active line in the
' "AttachedDB" table.
' 2009-01-02 skip the Link Management and local tables
 
Dim DB As DAO.Database
Dim td As TableDef
Dim I As Integer, sw As Long, newPath As String
 
    DoCmd.Hourglass True
    newPath = ";DATABASE=" & DB_name
    Set DB = CurrentDb()
    For I = 0 To DB.TableDefs.Count - 1
        Set td = DB.TableDefs(I)
        sw = (td.Attributes And DB_ATTACHEDTABLE)   ' local/attached table ?
        If (td.Name <> "AttachedDB" And td.Name <> "tblParamètre") Then
                ' skip the link management and parameter (ReDimPos) tables
            If (sw <> 0) Then               ' skip local tables
                If (td.Connect <> "") Then  ' with a connect string ?
                    td.Connect = newPath
                    td.RefreshLink
                End If
            End If
        End If
    Next I
    DoCmd.Hourglass False
End Sub

Si dans la fenêtre de navigation, je supprime dans ma base PROG les tables attachées à une base DATA non protégée puis veux attacher les tables de la base DATA protégée ("...Privé"), le mot de passe m'est bien demandé. Et pas dans ma routine...Je n'ai pas trouvé la syntaxe où préciser le mot de passe, obtenu par ma propre boîte de dialogue.

Une idée, une suggestion ? Merci d'avance

[RobiPMS]

Bonjour.
Voici le code que j'utilise pour attacher une table située dans une base protégée par un mot de passe :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
    Dim strMotPasse As String
    Dim strCheminBd As String
    Dim strNomTable As String
    Dim strConnect As String
    Dim oDb As DAO.Database
    Dim oTbl As DAO.TableDef
 
  ' Définit mot passe, nom table, chemin base de données
    strMotPasse = "ici le mot de passe"
    strCheminBd = "ici le chemin de la base"
 
  ' Instancie l'objet Database
    Set oDb = CurrentDb
 
  ' Définit la chaine de connexion permettant la liaison
    strConnect = "MS Access;pwd=" & strMotPasse & ";DATABASE=" & strCheminBd
 
  ' Crée un lien vers la table 
    strNomTable = "xxxxxxx"
    Set oTbl = oDb.CreateTableDef(strNomTable)
    With oTbl
        .Connect = strConnect
        .SourceTableName = strNomTable
    End With
  ' Ajoute la table à la base de données
    oDb.TableDefs.Append oTbl: oDb.TableDefs.Refresh

En espérant que cela puisse t'aider à résoudre ton problème...
Cordialement

[EricDgn]

La solution donnée par RobiPMS est à mon avis la bonne, la chaîne de connexion n'étant pas la même selon que la base attachée est protégée ou non.
Il suffit donc de remplacer la ligne 13 de ton code par quelque chose du genre:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
   If InStr(DB_name, "priv") > 0 Then
      newPath = "MS Access;PWD=" & InputBox("Mot de passe:", "pw") & ";DATABASE=" & DB_name
   Else
      newPath = ";DATABASE=" & DB_name
   End If

Cordialement

[mihego32]

Bonjour,

Merci, RobiPMS et EricDgn, pour vos réponses et les solutions que vous proposez. J'ai tardé à répondre parce que j'ai voulu d'abord les appliquer jusqu'à la solution complète. C'est la solution d'EricDgn que j'ai pu appliquer mutatis mutandi car je pouvais conserver l'articulation existante de mon code, même si la solution de RobiPMS est très élégante, bien qu'impliquant de supprimer les tables liées avant de les recréer avec le nouveau lien.

Toutefois, ces 2 solutions codaient le mot de passe en "dur" dans la base Programme et ne convenaient donc pas si j'ai pour la même application 2 bases DATA ayant chacune leur propre mot de passe. J'ai donc cherché une méthode pour renseigner le mot de passe dynamiquement dans ce contexte : le formulaire du menu principal FrmM lance le formulaire de choix de la DATA db FrmD. Depuis celui-ci, j'ouvre un formulaire dédié avec zone à masque "mot de passe" et boutons "Abandonner" et "Valider" FrmPW.

Je l'ai abandonné après moultes essais car :
(1) ce formulaire indépendant et modal FrmPW a choisi tout-à-coup de s'ouvrir, non pas dans la fenêtre de mon application Accces avec FrmM et FrmD, qui tournait sur mon écran additionnel de 23", placé à droite du PC portable, mais bien dans le coin inférieur gauche de l'écran de base 15" de ce portable ; ridicule mais pas moyen de le faire revenir à une position plus classique ;
(2) parce que son évènement On_Close provoquait non sa fermeture mais celle d'un des 2 formulaires antérieurs, minimisés ou pas, même en précisant le nom du formulaire à fermer !

Finalement, j'ai supprimé FrmPW ! J'ai ajouté dans l'en-tête de FrmD (en continu) un contrôle ctlPwd avec masque "mot de passe", invisible par défaut et rendu visible et activé lorsque la base choisie est protégée, en prévoyant le code pour sortir de FrmD sans rien faire si rien n'avait été modifié dans l'un des enregistrements.

Voici un extrait du code du formulaire FrmD, avec passage du curseur du contrôle ctlPwd vers le bouton cmdExit et traitement via l'évènement ON_Unload au lieu de On_Close car celui-ci n'a pas d'argument Cancel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
Private Sub Form_Open(Cancel As Integer)
' ...
    swModif = False         ' avant toute modification
End Sub
Private Sub Form_Dirty(Cancel As Integer)
    swModif = True         ' il y a eu modification
End Sub
Private Sub ctlPwd_AfterUpdate()
    Me.cmdExit.SetFocus
    cmdExit_Click
End Sub
Private Sub cmdExit_Click()
    On Error GoTo Err_cmdExit_Click
    If swModif = False Then         ' aucune modification
        DoCmd.Close
        Exit Sub
    End If
    If Me.Dirty Then                    ' enregistrement modifié
        DoCmd.RunCommand acCmdSaveRecord        ' à sauver
    End If
    nbActive = DCount("blnActive", "qselfrmManageLinks", "[blnActive]=On")
    If nbActive <> 1 Then
        MsgBox "Une seule base active, svp, ni plus ni moins !", _
                vbOKOnly, "Sélection"
    Else
        nbProtected = DCount("blnProtected", "qselfrmActiveDB", _
                             "[blnProtected]=On")
        If nbProtected Then         ' la base DATA choisie est protégée
            strPassword = ""
            If IsNull(Me.ctlPwd) Then       ' mot de passe pas donné
                If Me.ctlPwd.Visible = False Then    '  pas encore
                    MsgBox "La base Data de l'application choisie " & _
                        "est protégée !" & vbCrLf & "Mot de passe requis" _
                        & vbCrLf & "Abandon en tapant EXIT", _
                        vbInformation, "Validation"
                    Me.ctlPwd.Visible = True
                    Me.ctlPwd.SetFocus
                End If
                Exit Sub
            Else
                strPassword = Me.ctlPwd
                blnPasswordOK = True
                Me.ctlPwd.Visible = False
            End If
        End If
        DoCmd.Close
    End If
Exit_cmdExit_Click:
    Exit Sub
Err_cmdExit_Click:
    MsgBox Err.Description
    Resume Exit_cmdExit_Click
End Sub '--------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)  ' avant le Close effectif
    If swModif = False Then
        Exit Sub
    End If
    If strPassword = "EXIT" Then
        MsgBox "Il faudra recommencer le choix de " _
            & "l'application !" & vbCrLf & "Les liaisons" & _
            " n'ont pu être actualisées", , "Abandon"
    Else
        Forms![fmnuMenu].RecordSource = "qselfrmActiveDB"
                ' indispensable pour afficher la bonne DATA DB
        aApp = Forms![fmnuMenu]![ctlAPPpath]    '
        If aApp <> CurApp Then          ' changement d'application
            AttachTables (aApp)
            If swAttach = False Then
                 MsgBox "Les liaisons n'ont pu être actualisées", _
                        , "Abandon"
                Cancel = True
            End If
        End If
    End If
End Sub '--------------------------------------------------------------------
Sub AttachTables(DB_name As String)
Dim DB As DAO.Database
Dim td As TableDef
Dim I As Integer, sw As Long, newPath As String
    On Error GoTo Err_AttachTables
    swAttach = False
    newPath = ""
    DoCmd.Hourglass True
    If blnPasswordOK Then       ' mot de passe nécessaire et donné
        newPath = "MS Access;PWD=" & strPassword
    End If
    newPath = newPath & ";DATABASE=" & DB_name
    Set DB = CurrentDb()
    For I = 0 To DB.TableDefs.Count - 1
        Set td = DB.TableDefs(I)
        sw = (td.Attributes And DB_ATTACHEDTABLE)   ' local/attached table ?
        If (td.Name <> "AttachedDB" And td.Name <> "tblParamètre") Then
                ' skip the link management and parameter (ReDimPos) tables
            If (sw <> 0) Then               ' skip local tables
                If (td.Connect <> "") Then  ' with a connect string ?
                    td.Connect = newPath
                    td.RefreshLink
                End If
            End If
        End If
    Next I
    swAttach = True
Exit_AttachTables:
    DoCmd.Hourglass False
    Exit Sub
Err_AttachTables:
    MsgBox Err.Number & " " & Err.Description & " " & td.Name _
             & vbCrLf & newPath
    Resume Exit_AttachTables
End Sub '--------------------------------------------------------------------

Et tout cela fonctionne parfaitement et est aisément transposable vers mes autres applications multi-DB.

Je vous remercie pour vos conseils et reste à la disposition de celles ou ceux qui voudraient en savoir plus.