Sub CreateRelationship(RelName As String, Table1 As String, Table2 As String, PrimField As String, ForField As String)
Dim db As DAO.Database
Dim Rel As DAO.Relation
Dim Fld As Field
Set db = CurrentDb()
Set Rel = db.CreateRelation(RelName, Table1, Table2)
Rel.Attributes = dbRelationUpdateCascade And dbRelationDeleteCascade
Set Fld = Rel.CreateField(PrimField)
Fld.ForeignName = ForField
Rel.Fields.Append Fld 'This is the line causing the error
db.Relations.Append Rel
db.Relations.Refresh
Set db = Nothing
End Sub
|