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 : 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
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