Problème avec code table liée

Version imprimable

Bonjour,

J'ai trouver grâce à votre forum comment refaire la liaison de table, mais je me heurte a un soucis.

J'ai bien appliqué le code "Lier les tables" de Dolphy mais il me marque une erreur 3001 et me souligne le Refreshlink. Je suis débutant en Vba mais je ne comprend pas pourquoi une tel erreur???

Merci pour votre aide

Le code :

Code:

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
Function LierTables(strChmFichier As String) As Boolean
'---------------------------------------------------------------------------------------
' Procédure      : Function ==> LierTables
' Auteur         : Dolphy           http://dolphy35.developpez.com/
' Commentaires   : Permet de remettre les liaisons en fonction du chemin sélectionné
' Lien vers Faq  : néant
'---------------------------------------------------------------------------------------
'
    'Déclaration des variables
    Dim dbBase As DAO.Database
    Dim tbdTables As DAO.TableDef
    Dim rst As DAO.Recordset
    
    'Initialise le retour de la Fonction
    LierTables = False
    
    'Instancie la base courrante
    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 Tables contenant la liste des tables attachées
    DoCmd.RunSQL "DELETE * FROM tblTablesAttachees"
    
    'Boucle Parcourant toutes les tables de la Bdd en cours
    For Each tbdTables In dbBase.TableDefs
        
        'Teste l'attribut de la table pour savoir si c'est une table liée
        If tbdTables.Attributes And dbAttachedTable Then
            rst.AddNew                              'Ajoute un enregistrements
            rst!TablesAttachees = tbdTables.Name    'Ajoute la table dans le Champs
            rst.Update                              'Mise à jour
        End If
       
    Next tbdTables
    
    'Mise à jour du Recordset après ajout des tables
    rst.Requery
    
    'Test la position du pointeur si il ne se situe pas en début de table
    If Not rst.BOF Then
        rst.MoveFirst   'déplacement du pointeur sur le premier enregistrement
    End If

    'Boucle parcours de la table tant que l'on arrive pas sur le dernier.
    While Not rst.EOF
        
        'Définition de l'objet TableDefs avec table stockées dans TablesAttachees
        With dbBase.TableDefs(rst!TablesAttachees.Value)
            'Redéfini la propriété connect de la table avec la nouvelle base
            .Connect = ";DATABASE =" & strChmFichier
            'Remet à jour la liaison de la table
           .RefreshLink (c'est ca qu'il me marque en erreur???)
        End With
        'Efface l'enregistrement de la Table
        rst.Delete
        'Enregistrement suivant
        rst.MoveNext
        
    Wend
    
    'Liberation des variables
    dbBase.Close
    Set dbBase = Nothing
    Set rst = Nothing
    
    'Re-active les messages d'alertes
    DoCmd.SetWarnings True

    'Affiche Message
    MsgBox ("mise à jour terminée")
    
    'Renvoi la fonction à true
    LierTables = True
    
End Function

03/03/2013, 16h18
jimbolion

Liaison de table
manutazounet,

Pour la partie code tout à l'air OK. Je viens de le valider sur mon PC.

Donc je crains que tu n'es un lien dans ta table actuelle qui pointe vers une table (ou un chemoin invalide) qui n'existerait plus dans la dorsale.

Afin de savoir laquelle rajoute un msgbox devant l'erreur :
Code:

1 2 3 4 .Connect = ";DATABASE =" & strChmFichier 'Remet à jour la liaison de la table msgbox strChmFichier .RefreshLink '(c'est ca qu'il me marque en erreur???)
Tiens moi au courant

JimBoLion
03/03/2013, 17h15
manutazounet

Liaison de table

Merci pour ta réponse. Je viens de mettre la MsgBox le soucis c'est qu'il me met toujours l'erreur et en plus la MsgBox s'affiche mais vide. Dans ma table tblTablesAttachees j'ai bien toutes les tables qui se trouvent dans la dorsale.
03/03/2013, 17h29
LedZeppII
Bonjour,

Est-ce que tu appelles bien la fonction en lui donnant en paramètre le nouveau chemin complet vers la dorsale ?
Par exemple :
Code:

1 2 3 4 Dim strLaNouvelleDorsale As String strLaNouvelleDorsale = "C:\Documents and Settings\Moi\Mes documents\La Dorsale.mdb" LierTables strLaNouvelleDorsale
A+

ah non car en fait je t'explique. J'ouvre ma base j'ai un code qui recherche si la liaison avec la dorsale est faite sinon cela n'ouvre une fenêtre pour que j'aille chercher l'emplacement de ma dorsale et faire la liaison.

Code au démarrage :

Code:

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
Private Sub Form_Timer()
'---------------------------------------------------------------------------------------
' Procédure      : Sub  ==> Form_Timer
' Auteur         : Dolphy           <a href="http://dolphy35.developpez.com/" target="_blank">http://dolphy35.developpez.com/</a>
' Commentaires   : Permet de contrôler et de proposer les mise à jour des tables
' Lien vers Faq  : néant
'---------------------------------------------------------------------------------------
'
On Error GoTo Err_Form_timer
 
'Déclaration variable
Dim strTemp As String
Dim strChemin As String
 
    'arrêt d timer
    Me.TimerInterval = 0
 
    If DLookup("VerrouAdmin", "tblAdmin") = False Then
 
        DoCmd.Close
        DoCmd.OpenForm ("MenuGeneral")
        Exit Sub
 
    End If
 
Err_Form_timer:
 
    Select Case Err.Number
 
        Case 3024, 3044  'Erreur lévée si Access ne trouve pas la base Principale ou le chemin n'est pas valide
 
            If MsgBox("La connexion à la base principale à échouée, " & vbCrLf & _
            "voulez-vous redéfinir les liaisons ?", vbYesNo + vbExclamation, "") = vbYes Then
 
annul:
                'Ouverture de la fenêtre Windows et stockage du chemin dans la variable
                strChemin = OuvrirUnFichier()
 
                'Test si présence de caractères dans la variable au cas où l'utilisateur annule
                If Len(strChemin) <> 0 Then
 
                    'Appel Fonction de Liaison table avce le chemin en paramètre et test retour de la fonction
                    If LierTables(strChemin) = True Then
 
                        DoCmd.Close
                        'Code si la fonction c'est réalisée sans encombre
                        DoCmd.OpenForm ("MenuGeneral")
 
                    Else
 
                        'Message si la fonction n'a pas renvoyer le True
                        MsgBox "Mise à jour des Tables non éffectuées, " & vbCrLf & _
                        "veuillez contacter l'administrateur de la base.", vbCritical, "Liaisons des tables"
                        'Fermeture de l'application
                        DoCmd.Quit
 
                    End If
 
                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
                        'retour début proécédure d'appel des fonctions
                        GoTo annul
 
                    End If
 
 
                End If
 
            Else
                'Fermeture de l'application
                DoCmd.Quit
 
            End If
 
        Case 3043   'Erreur levée si Access n'arrive ps à se connecter au réseau
 
            MsgBox "Il est impossible de se connecter au réseau," & vbCrLf & _
            "veuillez contacter votre administrateur réseau.", vbCritical, "Erreur réseau"
 
        Case 3049, 3428  'Base Principale corrompue
 
            MsgBox "La base principale est endommagée," & vbCrLf & _
            "veuillez contacter l'administrateur de cette base.", vbCritical, "Base Principale endommagée"
 
        Case Else
 
            MsgBox "Erreur N°" & Err.Number & vbCrLf & Err.Description
 
    End Select
End Sub

Code pour avoir une fenêtre qui s'ouvre pour chercher l'emplacement (peut être dans ce code ou il y a un soucis??)

Code:

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
Public Function OuvrirUnFichier()
Dim strFichier As String
Dim oFD As FileDialog
'Paramètre la fenêtre Ouvrir
Set oFD = Application.FileDialog(msoFileDialogOpen)
With oFD
'Ajoute les filtres pour fichiers images et tous
With .Filters
.Clear
.Add "Fichiers mdb", "*.mdb", 1
.Add "Tous", "*.*", 2
End With
'Renseignement du titre
.Title = "Insérer une liaison"
'Ouvre l'explorateur dans le fichier 'Mes documents' du User connecté.
.InitialFileName = ""
'Interdit la multi sélection
.AllowMultiSelect = False
'Permet de choisir le mode d'affichage dans l'explorateur (ici apperçu)
.InitialView = msoFileDialogViewPreview
'Permet de personnaliser le bouton.
.ButtonName = "Insérer"
'Affiche la fenêtre
.Show
End With
End Function

Il manquait deux ou trois petites choses dans OuvrirUnFichier().
Essaie avec ça:

Code:

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
Public Function OuvrirUnFichier()
Dim strFichier As String
Dim oFD As FileDialog
'Paramètre la fenêtre Ouvrir
Set oFD = Application.FileDialog(msoFileDialogOpen)
With oFD
'Ajoute les filtres pour fichiers images et tous
With .Filters
.Clear
.Add "Fichiers mdb", "*.mdb", 1
.Add "Tous", "*.*", 2
End With
'Renseignement du titre
.Title = "Insérer une liaison"
'Ouvre l'explorateur dans le fichier 'Mes documents' du User connecté.
.InitialFileName = ""
'Interdit la multi sélection
.AllowMultiSelect = False
'Permet de choisir le mode d'affichage dans l'explorateur (ici apperçu)
.InitialView = msoFileDialogViewPreview
'Permet de personnaliser le bouton.
.ButtonName = "Insérer"
'Affiche la fenêtre
If .Show() = True Then
   strFichier = .SelectedItems(1)
End If
End With
 
'Renvoyer Fichier
OuvrirUnFichier = strFichier
End Function

03/03/2013, 18h02
jimbolion

Liaison de table

Effectivement je n'ai pas essayé la fonction ouverture du fichier

Sorry

JimBoLion
03/03/2013, 18h14
manutazounet

Le fait d'avoir rajouté les lignes de codes cela me remet la même erreur. une question sur le code que tu m'as dit de rajouter le (1) après SelectedItems correspond à quoi stp?
03/03/2013, 18h36
LedZeppII
Dans le code de la fonction OuvrirUnFichier() que tu as posté il manquait ...
- la récupération du fichier sélectionné.
Ici on recopie le fichier sélectionné (SelectedItems(1)) dans strFichier :
Code:

1 2 3 If .Show() = True Then strFichier = .SelectedItems(1) End If
- le retour du fichier sélectionné.
Ici on renvoie strFichier:
Code:

1 2 'Renvoyer Fichier OuvrirUnFichier = strFichier
03/03/2013, 18h46
manutazounet

D'accord merci pour l'explication mais il me renvoie toujours la même erreur 3001 sur le Refreshlink. J'ai regarder le StrChmFichier contient bien le chemin de ma base dorsale mais ca ne fonctionne toujours pas....

Je ne sais pas ce que ça peut être.
Essaie avec cette version LierTables(), pour voir si ça le fait sur toutes les tables ou seulement certaines.
Un message s'affichera pour chaque erreur.
Clique sur «Non» pour continuer et passer à la table suivante.

Code:

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
Function LierTables(strChmFichier As String) As Boolean
'---------------------------------------------------------------------------------------
' Procédure      : Function ==> LierTables
' Auteur         : Dolphy           http://dolphy35.developpez.com/
' Commentaires   : Permet de remettre les liaisons en fonction du chemin sélectionné
' Lien vers Faq  : néant
'---------------------------------------------------------------------------------------
'
    'Déclaration des variables
    Dim dbBase As DAO.Database
    Dim tbdTables As DAO.TableDef
    Dim rst As DAO.Recordset
 
    'Initialise le retour de la Fonction
    LierTables = False
 
    'Instancie la base courrante
    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 Tables contenant la liste des tables attachées
    DoCmd.RunSQL "DELETE * FROM tblTablesAttachees"
 
    'Boucle Parcourant toutes les tables de la Bdd en cours
    For Each tbdTables In dbBase.TableDefs
 
        'Teste l'attribut de la table pour savoir si c'est une table liée
        If tbdTables.Attributes And dbAttachedTable Then
            rst.AddNew                              'Ajoute un enregistrements
            rst!TablesAttachees = tbdTables.Name    'Ajoute la table dans le Champs
            rst.Update                              'Mise à jour
        End If
 
    Next tbdTables
 
    'Mise à jour du Recordset après ajout des tables
    rst.Requery
 
    'Test la position du pointeur si il ne se situe pas en début de table
    If Not rst.BOF Then
        rst.MoveFirst   'déplacement du pointeur sur le premier enregistrement
    End If
 
    ' Temporaire, pour débogguer
    On Error GoTo GestionErreur
 
    'Boucle parcours de la table tant que l'on arrive pas sur le dernier.
    While Not rst.EOF
 
        'Définition de l'objet TableDefs avec table stockées dans TablesAttachees
        With dbBase.TableDefs(rst!TablesAttachees.Value)
            'Redéfini la propriété connect de la table avec la nouvelle base
            .Connect = ";DATABASE=" & strChmFichier
            'Remet à jour la liaison de la table
            .RefreshLink
        End With
        'Efface l'enregistrement de la Table
        rst.Delete
        'Enregistrement suivant
        rst.MoveNext
 
    Wend
 
    'Liberation des variables
    dbBase.Close
    Set dbBase = Nothing
    Set rst = Nothing
 
    'Re-active les messages d'alertes
    DoCmd.SetWarnings True
 
    'Affiche Message
    MsgBox ("mise à jour terminée")
 
    'Renvoi la fonction à true
    LierTables = True
 
Sortie:
    Exit Function
 
GestionErreur:
    If MsgBox("Table " & rst!TablesAttachees.Value & vbCrLf & _
               "Erreur No." & Err.Number & " : " & Err.Description & _
               vbCrLf & vbCrLf & _
               "Arrêter de lier les tables ?", vbYesNo + vbDefaultButton2) = vbNo Then
       Resume Next
    Else
       Resume Sortie
    End If
 
End Function

03/03/2013, 19h34
manutazounet

Bonne nouvelle ton code fonctionne presque. il me met bien a jour les liaisons et m'affiche la MsgBox avec mise a jour reussi il me lance mon menu general mais aussi ne reouvre le code ouvrirfichier() et quand je regarde le code je ne vois pas pourquoi
03/03/2013, 19h48
LedZeppII

Etrange. Je suis parti d'un copier/coller du tutoriel.

A aucun moment tu n'as eu un message de ce style ?

Citation:

Table xxxxxxxxxx

Erreur No.xxxx : Descritpion_de_l_erreur.

Arrêter de lier les tables ?
03/03/2013, 20h07
manutazounet

C'est bon j'ai trouvé je suis trop con lol. Ton code est excellent mea culpa c'est de ma faute en fait dans ma procedure timer il fallait juste enlever le goto annul (annul faisant appel a la fonction ouvrirfichier).

Merci pour votre aide
24/04/2013, 22h59
Tierisa

probleme apres changement de lien des tables

Bonjour
J'ai suivi à la lettre le code qui est écrit plus haut et le changement de liens de tables se fait trés bien.
Par contre voici mon probleme: j'ai la base frontale sur mon C et les tables sur le reseau. Quand je ne suis pas connecté au reseau je fais automatiquement le changement de liens des tables sur celles qui sont sur mon C que j'ai préalablement récupérées du réseau régulièrement.
Quand je vais vérifier dans le gestionniaire des tables, les liens pointent bien sur celles sur mon disque mais malheureusement mon appli ne fonctionne plus et dés que je fais appel à des requetes via des zones de liste j'ai un message "reference d'objet de base de données incorrecte".
si je fais la manip inverse en me reconnectant au reseau à nouveau et en remettant les liens d'origines avec le meme code, tout remarche nikel. quelqu'un a une idée du pourquoi du comment svp?

pour info complementaire, il y a des tables dont je n'ai pas changé le lien car je ne les utilise pas hors connection, le lien reste donc pointé sur le reseau. Est-ce que cela peut avoir une influence?
merci d'avance

derniere news: je viens de faire un replica de l'appli avec les liens vers le disque C, l'appli maitre ne fonctionne pas mais le replica marche impeccable et pourtant les liens sont les memes! que fait un replica en plus qui permet d'avoir correctement la liaison?
28/04/2013, 13h20
Tierisa

bonjour
je n'ai pas encore reçu de réponse à ce post mais j'ai un complement d'information: il semblerait que cela soit le ".refreshlink" qui pose probleme et ne se fasse pas car lorsque je desactive la gestion d'erreur dans le code, il plante à cet endroit.
merci de votre aide