Sub CreateRelation()
Dim tbl As ADOX.Table
Dim fk As ADOX.Key
Dim cat As ADOX.Catalog
Set cat = New ADOX.Catalog
cat.ActiveConnection = CurrentProject.Connection
Set tbl = cat.Tables("tblPeople")
Set fk = New ADOX.Key
With fk
.Name = "PeopleFood"
.Type = adKeyForeign
.RelatedTable = "Foods"
.Columns.Append "FoodID"
.Columns("FoodID").RelatedColumn = "FoodID"
End With
tbl.Keys.Append fk
Set cat = Nothing
Set tbl = Nothing
Set fk = Nothing
End Sub