VBA/Excel/Access/Word/Access/Relationship

Create Relation

   <source lang="vb">

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

</source>
   
  

Creating a One-to-Many Relationship

   <source lang="vb">

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

</source>
   
  

Show all foreign tables from a relation

   <source lang="vb">

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

</source>