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("rntsoftTable").Keys.Append fKey
MsgBox "Relationship was created."
Set cat = Nothing
Exit Sub
ErrorHandle:
cat.Tables("rntsoftTable").Keys.Delete "fkPubId"
Resume
End Sub