VBA/Excel/Access/Word/Access/Relationship

Create Relation

 
Sub exaRelations()
    Dim db As Database
    Dim rel As Relation
    Dim fld As Field
    
    Set db = CurrentDb
    Set rel = db.CreateRelation("PublisherRegions", "PUBLISHERS", "SALESREGIONS")
    rel.Attributes = dbRelationUpdateCascade
    Set fld = rel.CreateField("PubID")
    fld.ForeignName = "PubID"
    rel.Fields.Append fld
    db.Relations.Append rel
End Sub

Creating a One-to-Many Relationship

 
Sub CreateTblRelation()
   Dim cat As New ADOX.Catalog
   Dim fKey As New ADOX.Key
   On Error GoTo ErrorHandle
   cat.ActiveConnection = CurrentProject.Connection
   With fKey
      .Name = "fkPubId"
      .Type = adKeyForeign
      .RelatedTable = "Employee"
      .Columns.Append "EmpId"
      .Columns("Id").RelatedColumn = "PubId"
   End With
   cat.Tables("vbexTable").Keys.Append fKey
   MsgBox "Relationship was created."
   Set cat = Nothing
   Exit Sub
ErrorHandle:
   cat.Tables("vbexTable").Keys.Delete "fkPubId"
   Resume
End Sub

Show all foreign tables from a relation

 
Sub ShowRelations()
    Dim db As Database
    Dim rel As Relation
    Dim strDetail As String
    
    Set db = CurrentDb()
    
    Debug.Print "Relationships:"
    Debug.Print
    For Each rel In db.Relations
        strDetail = rel.Table & " is related to " & rel.ForeignTable
        Debug.Print strDetail
    Next
End Sub