Discussion :

[4rocky4]

L'application se ferme lorsque je saisie une base inconnu.
Je dois y aller là, je regarde plus précisement ce soir ou demain.

Merci beaucoup

[4rocky4]

Bonjour,

J'ai arrangé le code comme je voulais, maintenant tout se passe bien. je vous remercie.

Juste une dernière petite question, liertable est donc une procédure et pas une fonction ici ?

[Domi2]

Bonjour,

J'ai fait un ou deux tests.

Il peut également se produire une erreur 3078. On peut donc enrichir la gestion d'erreur.

Pour ce qui de LierTable, je l'ai laissée comme fonction, mais on peut très en faire une procédure, car elle ne retourne plus de valeur.

S tout cela te convient, n'oublie pas le tag "Résolu".

Domi2

[4rocky4]

Il peut également se produire une erreur 3078. On peut donc enrichir la gestion d'erreur.

Comment obtient-on cette erreur ?

[Domi2]

Re,

J'ai mis une MsgBox au début de ma gestion d'erreur indiquant le numéro d'erreur et sa description, puis j'ai fait divers essais en sélectionnant des bases dorsales incorrectes. La plupart du temps, c'est l'erreur 3011 qui se produit, mais également l'erreur 3078 (avec la même description).

Donc, on peut légérement modifier le code pour en tenir compte :

Code :

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

1
2
3
4
5
6
7
8
Err_LierTable:
 
    'MsgBox Err.Number & vbCrLf & vbCrLf & Err.Description
 
    Select Case Err.Number
 
        'Le rafraîchissement des liens a échoué
        Case 3011, 3078

Il est possible qu'il y ait d'autres erreurs dont on pourrait tenir compte, mais pour les trapper correctement, il faut installer une gestion d'erreurs.

Il y'a d'ailleurs un excellent tutoriel sur le sujet.

Domi2

[4rocky4]

Merci bien, je vais regarder tout ca.
Voilà comment j'ai fait la fin de liertable :

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
Case Else
 
            'Message si la fonction a échoué
            If MsgBox("Mise à jour des Tables non effectuées" & vbCrLf & _
            "Voulez-vous réessayer ?", vbYesNo + vbCritical, "Liaisons des tables") = vbYes Then
 
                'on libère les variable
                dbBase.Close
                Set dbBase = Nothing
                Set rst = Nothing
                'On active les messages d'alertes
                DoCmd.SetWarnings True
 
                'retourne à la selection de fichier
                LierTable
 
            Else
                'on libère les variable
                dbBase.Close
                Set dbBase = Nothing
                Set rst = Nothing
                'On active les messages d'alertes
                DoCmd.SetWarnings True
                'On ferme l'application
                DoCmd.Quit
            End If

[Domi2]

Re,

Non, il n'est pas bon de faire comme ceci.

Tu n'as peut-être pas très bien saisi la logique utilisée ici (d'autant plus que je ne suis pas forcément très clair).

En fait, on "récupère" une erreur levée par Access et on la "détourne" à notre profit.

Dans ce cas, on gère les erreurs 3011 et 3078, car après test, on a établi qu'elles se produisaient lors d'une erreur dans le rafraîchissement des liens. Et c'est exactement ce qu'on cherche à faire.

Donc, si erreur 3011 et 3078, on propose à l'utilisateur de choisir une nouvelle dorsale.

Maintenant, il peut se produire une erreur inattendue, due à un autre problème, et qu'on a pas prévue.

De la façon dont tu as fait ton code après le "Else", ton application va systématiquement redemander de sélectionner une base et l'utilisateur va "boucler" sans fin.

Ok ?

Domi2

[4rocky4]

Oui oui, j'ai compris.
Il faut que je note l'erreur que j'obtiens et que je la mette dans le code aussi.

Mais bon ces erreurs là interviennent forcément lorsque le choix de la base est incorrect ... donc le choix d'une nouvelle base est forcément obligatoire derrière

[Domi2]

Re,

Mais bon ces erreurs là interviennent forcément lorsque le choix de la base est incorrect ... donc le choix d'une nouvelle base est forcément obligatoire derrière

Non, on se doit de gérer l'erreur imprévue...

Donc, si tu détectes d'autres erreurs "gérables", tu les ajoutes à celles déjà connues.

Et pour le reste, il faut prévoir de pouvoir sortir "proprement" de l'application en cas de problème.

Domi2

[4rocky4]

J'ai donc fait comme ceci :

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
Err_LierTable:
 
    Select Case Err.Number
 
        'Le rafraîchissement des liens a échoué
        Case 3011, 3078
 
        'Message avertissant l'utilisateur que le choix de la base dorsale n'est pas correct
            If MsgBox("La base dorsale n'a pas été trouvée !" & vbCrLf & _
                "Voulez-vous réessayer ?", vbYesNo + vbInformation, "Liaisons des tables") = vbYes Then
 
                'on libère les variable
                dbBase.Close
                Set dbBase = Nothing
                Set rst = Nothing
                'On active les messages d'alertes
                DoCmd.SetWarnings True
 
                'On recommence la fonction
                 LierTable
 
            Else
 
                'on libère les variable
                dbBase.Close
                Set dbBase = Nothing
                Set rst = Nothing
                'On active les messages d'alertes
                DoCmd.SetWarnings True
 
                'Fermeture de l'application
                DoCmd.Quit
 
            End If
 
          ' Nom du chemin inconnu
         Case 3044
            'Message si la fonction a échoué
            If MsgBox("Mise à jour des Tables non effectuées" & vbCrLf & _
            "Voulez-vous réessayer ?", vbYesNo + vbCritical, "Liaisons des tables") = vbYes Then
 
                'on libère les variable
                dbBase.Close
                Set dbBase = Nothing
                Set rst = Nothing
                'On active les messages d'alertes
                DoCmd.SetWarnings True
 
                'retourne à la selection de fichier
                LierTable
 
            Else
                'on libère les variable
                dbBase.Close
                Set dbBase = Nothing
                Set rst = Nothing
                'On active les messages d'alertes
                DoCmd.SetWarnings True
                'On ferme l'application
                DoCmd.Quit
            End If
 
         Case Else
 
            'Message si la fonction a échoué
            MsgBox "Mise à jour des Tables non effectuées, " & vbCrLf & _
            "veuillez contacter l'administrateur de la base.", vbCritical, "Liaisons des tables"
 
            'on libère les variable
            dbBase.Close
            Set dbBase = Nothing
            Set rst = Nothing
            'On active les messages d'alertes
            DoCmd.SetWarnings True
 
            'Fermeture de l'application
            DoCmd.Quit
 
        End Select
 
End Sub

Mais je ne comprend pas, je ne rentre pas dans le case 3044, il passe directement au case else du coup. Pourtant l'erreur est bien 3044

[4rocky4]

Tu dois gérer ton erreur 3044 avant le Else.

Quel Else ?
le Else de select Case est après ...

[Domi2]

Re,

Comment as-tu obtenu ce numéro d'erreur ?

Domi2

[4rocky4]

J'obtiens cette erreur lorsque je saisie le nom d'une base incorrect lors de la selection de la liaison

[Domi2]

Sorry pour tout à l'heure, j'ai été trop vite.

J'obtiens cette erreur lorsque je saisie le nom d'une base incorrect lors de la selection de la liaison

Tu as vérifié avec une msgBox ?

Code :

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

1
2
3
4
5
6
7
8
Err_LierTable:
 
    MsgBox Err.Number & vbCrLf & vbCrLf & Err.Description
 
    Select Case Err.Number
 
        'Le rafraîchissement des liens a échoué
        Case 3011, 3078

Domi2

[4rocky4]

Effectivement, c'était pas 3044 mais 3024

ok donc bon l'erreur est géré maintenant.
Je ne pense plus que j'ai à modifier ce code pour l'instant alors.

Merci pour toute ton aide

[Domi2]

Re,

Alors effectivement, si je tape un nom de fichier inconnu, j'obtiens une erreur 3024 et si je spécifie un chemin, une erreur 3044 (mais faut vraiment vouloir quand même).

Et ton code fonctionne bien.

Domi2

[4rocky4]

mais faut vraiment vouloir quand même

Faut s'attendre a tout

Tiens une autre erreur, 3343 !
Si l'utilisateur choisi un fichier word, excel ...

[Domi2]

Les erreurs 3024 et 3044 peuvent se produire. Le code doit donc être adapté en conséquence.

Ci-après, mon code :

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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
Option Compare Database
Option Explicit
 
Function LierTable()
 
    On Error GoTo Err_LierTable
 
    'Déclaration des variables
    Dim dbBase As DAO.Database
    Dim tdbTables As DAO.TableDef
    Dim rst As DAO.Recordset
 
    Dim strChmFichier As String
 
    'Instancie la base courante
    Set dbBase = CurrentDb
 
    'Charge la table dans le recordset rst
    Set rst = dbBase.OpenRecordset("tblTablesAttachees", dbOpenDynaset)
 
    'Inhibe les messages d'alertes
    DoCmd.SetWarnings False
 
    'Vide la table contenant les tables qui sont attachées
    DoCmd.RunSQL "DELETE * FROM tblTablesAttachees"
 
    'Boucle parcourant la base de données IEDV
    For Each tdbTables In dbBase.TableDefs
        'Test pour savoir si c'est une table liée
        If tdbTables.Attributes And dbAttachedTable Then
            rst.AddNew 'Ajoute un enregistrement
            rst!TablesAttachees = tdbTables.Name 'Ajoute la table dans le champ
            rst.Update 'Mise à jour
        End If
    Next tdbTables
 
    'On met à jour le recordset après l'ajout des tables
    rst.Requery
 
    'On test la position du pointeur
    If Not rst.BOF Then
        rst.MoveFirst   'pointeur sur le premier enregistrement
    End If
 
SelectionFichier:
 
    'On ouvre la fenêtre Windows et on stocke le chemin dans la variable
    strChmFichier = OuvrirUnFichier(Application.hWndAccessApp, "Parcourir", 1, "Fichiers Access", "mdb")
 
    'Test si strchemin contient au moins 1 caractère
    If Len(strChmFichier) <> 0 Then
 
        'Mise à jour des liaisons des tables de la table tblTablesAttachees
        'On parcourt tant que l'on arrive pas sur le dernier enregistrement
        While Not rst.EOF
            'Nous définissons l'objet TableDefs en fonction de la table stockée dans tblTablesAttachees
            With dbBase.TableDefs(rst!TablesAttachees.Value)
                'Défini la propriété connect da le table avec la nouvelle base
                .Connect = ";DATABASE=" & strChmFichier
                'On remet à jour la liaison de la table
                .RefreshLink
            End With
            'on efface l'enregistrement de la table
            rst.Delete
            'On passe à l'enregistrement suivant
            rst.MoveNext
        Wend
 
    Else
 
        'Message si l'utilisateur à annuler la sélection du chemin
        If MsgBox("Annulation par utilisateur." & vbCrLf & _
            "Voulez-vous fermer l'application ?", vbYesNo + vbInformation, "Liaisons des tables") = vbYes Then
            'Fermeture de l'application
            DoCmd.Quit
 
        Else
 
            GoTo SelectionFichier
 
        End If
 
    End If
 
    'on libère les variable
    dbBase.Close
    Set dbBase = Nothing
    Set rst = Nothing
    'On active les messages d'alertes
    DoCmd.SetWarnings True
    ' on affiche un message
    MsgBox (" La mise à jour s'est correctement déroulée")
 
    Exit Function
 
Err_LierTable:
 
    MsgBox Err.Number & vbCrLf & vbCrLf & Err.Description
 
    Select Case Err.Number
 
        'Le rafraîchissement des liens a échoué
        Case 3011, 3078
 
        'Message avertissant l'utilisateur que le choix de la dorsale n'est pas correct
        If MsgBox("La base dorsale n'a pas été trouvée !" & vbCrLf & _
            "Voulez-vous réessayer ?", vbYesNo + vbInformation, "Liaisons des tables") = vbYes Then
 
            'On recommence la fonction
            'on libère les variable
            dbBase.Close
            Set dbBase = Nothing
            Set rst = Nothing
            'On active les messages d'alertes
            DoCmd.SetWarnings True
 
            'On recommence la fonction
            LierTable
 
        Else
 
            'on libère les variable
            dbBase.Close
            Set dbBase = Nothing
            Set rst = Nothing
            'On active les messages d'alertes
            DoCmd.SetWarnings True
 
            'Fermeture de l'application
            DoCmd.Quit
 
        End If
 
        Case 3024, 3044, 3343
        'Message si le chemin ou le nom de fichier ne sont pas trouvé
            If MsgBox("Mise à jour des Tables non effectuées" & vbCrLf & _
            "Voulez-vous réessayer ?", vbYesNo + vbCritical, "Liaisons des tables") = vbYes Then
 
                'on libère les variable
                dbBase.Close
                Set dbBase = Nothing
                Set rst = Nothing
                'On active les messages d'alertes
                DoCmd.SetWarnings True
 
                'retourne à la selection de fichier
                LierTable
 
            Else
                'on libère les variable
                dbBase.Close
                Set dbBase = Nothing
                Set rst = Nothing
                'On active les messages d'alertes
                DoCmd.SetWarnings True
                'On ferme l'application
                DoCmd.Quit
            End If
 
    Case Else
 
        'Message si la fonction a échoué
        MsgBox "Mise à jour des Tables non effectuées, " & vbCrLf & _
        "veuillez contacter l'administrateur de la base.", vbCritical, "Liaisons des tables"
 
        'on libère les variable
        dbBase.Close
        Set dbBase = Nothing
        Set rst = Nothing
        'On active les messages d'alertes
        DoCmd.SetWarnings True
 
        'Fermeture de l'application
        DoCmd.Quit
 
    End Select
 
End Function

Tiens une autre erreur, 3343 !
Si l'utilisateur choisi un fichier word, excel ...

Ben, tu gères (je viens de corriger mon code). Et accessoirement, tu changes d'utilisateur

Domi2

[4rocky4]

Voilà j'ai rajouté 3044.

Je tiens vraiment à faire cette gestion d'erreur, même les plus improbable car je vais certainement présenter cette base à mon examen et le jury va, en premier lieu, tester tout et n'importe quoi.

C'est pour cela que ma base doit être la plus propre possible.