Discussion :

[Jordywolf]

Bonjour,
je développe déjà depuis plusieurs années sous Access et j'ai toujours utilisé un module particulier assez simple pour modifier les liaisons de mes tables attachées. Il faut préciser que déploie toujours mes bases avec la source en réseau (tables) et le moteur (formulaires et autres) en local sur les postes utilisateurs.
Lors de ma dernière réalisation sous Access 2010, j'ai un problème avec ce module qui me génère une erreur sur la ligne .RefreshLinks et ne met plus a jour les liaisons.
Sauf que ... lorsque je compacte et répare la base de données CA MARCHE !!!
Je réessaie ensuite en déplaçant la base source (tables) et la ça ne marche plus !!!
Quelqu'un aurait-il une idée pourquoi tout d'un coup ce qui fonctionnait ne fonctionne plus? Je deviens marteau a force de regarder ce code que je vous livre ci-dessous.

Je precise que la procédure "Parcourir" ne sert qu'a ouvrir la boite de dialogue permettant de récupérer le nouveau chemin de la base source et de le stocker dans la variable "Path".
La procedure "closeform_mdpsource" est exécutée à la fermeture du formulaire permettant de taper le mot de passe de la base source et de le stocker dans la variable "strMdp".

Merci d'avance pour vos réponses eclairées.

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
 
Dim nbTbl As Long
Dim idx As Long
Dim Path As String
Dim strMdp As String
Dim dbs As DAO.Database
Dim TblDef As DAO.TableDef
 
Function fCheckLinks()
'permet de savoir si la liaison des tables est valide
 
'declaration
    Dim rst As DAO.Recordset
    Set dbs = CurrentDb()
'gestion de l'erreur
    On Error Resume Next
'compte le nombre de tables
    nbTbl = dbs.TableDefs.Count
'initialise un compteur de 0 jusqu'au nombre de table
        For idx = 0 To nbTbl - 1
'parcourt toutes les tables
        Set TblDef = dbs.TableDefs(idx)
'verfie si ce sont des tables attachées
            If TblDef.Attributes = dbAttachedTable Then
'stocke le nom de la table attaché dans un recorset
            Set rst = dbs.OpenRecordset(TblDef.Name)
            End If
'passe a la table suivante
        Next idx
'execute la routine de rafraichissement des liens s'il y a eu au moins une erreur
    If Err <> 0 Then
        MsgBox "La liaison des tables à la base principale doit être mise à jour"
 'appelle la procedure de rafraichissement des liaisons
     Call fRefreshLinks
    End If
'ferme le recordset
    rst.Close
'ferme la base
    dbs.Close
'libere les variables
    Set rst = Nothing
    Set dbs = Nothing
 
End Function
 
Sub fRefreshLinks()
'remet a jour les liaisons des tables
 
'gestion de l'erreur
    On Error Resume Next
'appelle la procedure qui ouvre la boite de dialogue parcourir
1    Call Parcourir
'affiche le formulaire qui permet d'entrer le mot de passe
2    DoCmd.OpenForm "F_MDP_SOURCE", acNormal, , , acFormAdd, acDialog
'initialise un compteur de 0 jusqu'au nombre de table
3    For idx = 0 To nbTbl - 1
'parcourt les tables
4    Set TblDef = dbs.TableDefs(idx)
'determine si les tables sont liées
5        If TblDef.Connect <> "" Then
'met a jour la liaison avec le nouveau chemin et mot de passe
6        TblDef.Connect = "MS Access;pwd=" & strMdp & ";DATABASE=" & Path
'rafraichit le lien
7        TblDef.RefreshLink
        dbs.TableDefs.Refresh
8    End If
9    Next idx
 
'affiche un message si tout s'est bien passé et arrete la procedure
10  If Err = 0 Then
11  MsgBox "Les Tables ont été correctement liées", vbInformation + vbOKOnly, "Liaison Table"
12  Exit Sub
13  Else
'affiche un message si erreur avec invite a recommencer
14    If MsgBox("Les Tables n'ont pas été trouvées dans la base sélectionnée, voulez-vous essayer à nouveau ?", _
        vbExclamation + vbYesNo, "Sélection non Valide") = vbNo Then
 
'effectue la fermeture de la base si choix non
15    dbs.Close
16    Set dbs = Nothing
17    Set TblDef = Nothing
18   x = MsgBox("Au Revoir !", vbCritical + vbOKOnly, "Fermeture de l'application")
19    DoCmd.Quit
20      Else
 
'recommence la procedure si choix oui
21  dbs.Close
22  Set dbs = Nothing
23  Set TblDef = Nothing
 
'rappelle la procedure de check lien
24  Call fCheckLinks
25  End If
26  End If
 
End Sub
 
 
Public Sub Parcourir()
'ouvre la boite de dialogue parcourir et recupere le chemin de la base source
 
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    Dim vrtSelectedItem As Variant
 
    With fd
        If fd.Show = -1 Then
             For Each vrtSelectedItem In .SelectedItems
                Path = vrtSelectedItem
            Next vrtSelectedItem
        Else
        End If
    End With
    Set fd = Nothing
End Sub
 
Public Sub closeform_mdpsource()
'recupere la valeur du mot de passe d'accés aux données source et ferme le formulaire
On Error Resume Next
strMdp = Forms![F_MDP_SOURCE]![E_mdp]
DoCmd.Close acForm, "F_MDP_SOURCE"
End Sub

[nico84]

Bonjour,

J'utilise les mêmes instructions dans un contexte un peu différent...
Quelle est la table qui déclenche l'erreur ? Est-ce bien une table à attacher ?
Par ailleurs je ne vois pas à quoi sert rst dans le code ?

[Jordywolf]

Salut,
aucune table ne declenche d'erreur. C'est juste l'instruction .Refreslinks qui en déclenche une.
le rst sert a stocker le nom des tables.

Une idée?

Cordialement,

[Invité]

Bonjour

Si cela fonctionne en mode pas à pas, essayes de mettre l'instruction DoEvents avant le Refresh pour voir.

Philippe