Utilisation fonction CreateRelation de l'objet database

Version imprimable

09/01/2025, 19h19
Fran45

Utilisation fonction CreateRelation de l'objet database

Bonjour,

Je trouve l'exemple du tuto Microsoft vraiment pas clair. Notamment dans la distinction clef primaire clef secondaire et ce besoin de créer des objets tables, champs et index temporaires alors que je souhaite partir de l'existant.

Si quelqu'un avait un exemple simple avec tables existantes correctement définies avec une table primaire et sa clé, et table primaire avec champs joints de même type.

Et surtout des noms distincts et significatifs pour chaque élément.

Merci de votre et meilleurs vœux.

Fran.

Le tuto en question que je trouve bien lourd pour seulement quelques lignes significatives.
https://learn.microsoft.com/fr-fr/of...ion-method-dao

Il y a en effet une ligne qui me semble être en dur, deuxième ligne :
relNew.Fields.Append relNew.CreateField("DeptID")
relNew.Fields!DeptID.ForeignName = "DeptID"

Bonjour Fran45,
Voici 3 fonctions qui devraient aider

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
	 Public Function TableRelationIntRef_create(oDb1 As dao.Database, primaryTableName As String, primaryFieldName As String, foreignTableName As String, foreignFieldName As String) As Boolean
'Usage: Call TableRelationIntRef_create(oDb1,"Table1", "EMP_ID", "Table2", "EMP_ID")

    On Error GoTo ErrHandler
    'Dim odb1 As DAO.Database
    Dim newRel As dao.Relation
    Dim relatingField As dao.Field
    Dim relationUniqueName As String
    relationUniqueName = primaryTableName + "_" + primaryFieldName + "__" + foreignTableName + "_" + foreignFieldName

    '   'Set oDb1 = CurrentDb()
    '     ' base remote à modifier
    '    Set oDb1 = GetLinkedTable_DbSource(primaryTableName)

    Set newRel = oDb1.CreateRelation(relationUniqueName, primaryTableName, foreignTableName)
    Set relatingField = newRel.CreateField(primaryFieldName)
    relatingField.ForeignName = foreignFieldName
    newRel.Fields.Append relatingField
    newRel.Attributes = dbRelationUpdateCascade Or dbRelationDeleteCascade    'dbRelationLeft Or dbRelationDeleteCascade

    oDb1.Relations.Append newRel  'erreur 3201 est levée
    'Set odb1 = Nothing
    TableRelationIntRef_create = True
    Exit Function

ErrHandler:
    Debug.Print "erreur " & err.Number, err.description, " (" + relationUniqueName + ")"
    TableRelationIntRef_create = False
End Function

Public Function TableRelations_delete(oDb As dao.Database, _
                                      strNomTable As String) As Integer
' 2019-03-19     La fonction retourne le nombre de relations supprimées.
'               Usage:    TableRelations_delete(oDb, "T_Client")
'                       pour supprimer les relations de la table T_Client
    Dim oRlt As dao.Relation
    'Pour chaque relation,
    For Each oRlt In oDb.Relations
        'si la table est utilisée
        If oRlt.Table = strNomTable Or oRlt.ForeignTable = strNomTable Then
            'Supprime la relation
            Debug.Print "relation supprimée : " & oRlt.Name
            oDb.Relations.Delete oRlt.Name
            oDb.Relations.Refresh
            'Incrémente le compteur
            TableRelations_delete = TableRelations_delete + 1
        End If
    Next oRlt
End Function

Public Function TableRelations_count(oDb As dao.Database, _
                                     strNomTable As String) As Integer
' 2019-03-21     La fonction retourne le nombre de relations existantes sur une table  
'   Usage   : TableRelations_count(oDb, "T_data_ayantDroit")

    Dim oRlt As dao.Relation, n As Integer
    n = 0
    For Each oRlt In oDb.Relations
        'si la table est utilisée
        If oRlt.Table = strNomTable Or oRlt.ForeignTable = strNomTable Then
            Debug.Print "relation : " & oRlt.Name
            'Incrémente le compteur
            n = n + 1
        End If
    Next oRlt
    TableRelations_count = n
End Function

Impeccable.
Merci micniv.

Partie du code que j'ai repris in extenso, il fallait passer par un objet field intermédiaire :

Code:

1
2
3
4
5
6
7
    Set newRel = oDb1.CreateRelation(relationUniqueName, primaryTableName, foreignTableName)
    Set relatingField = newRel.CreateField(primaryFieldName)
    relatingField.ForeignName = foreignFieldName
    newRel.Fields.Append relatingField
    newRel.Attributes = dbRelationUpdateCascade Or dbRelationDeleteCascade    'dbRelationLeft Or dbRelationDeleteCascade
 
    oDb1.Relations.Append newRel  'erreur 3201 est levée