Relation Object, Relations Collection Example (MDB)

The following example removes the existing relationship between an Employees table and an Orders table and then re-creates the relationship by creating a new Relation object.

Sub NewRelation()
    Dim dbs As Database
    Dim fld As Field, rel As Relation
    
    ' Return reference to current database.
    Set dbs = CurrentDb
    ' Find existing EmployeesOrders relation.
    For Each rel In dbs.Relations
        If rel.TABLE = "Employees" And _
            rel.ForeignTable = "Orders"
        Then
        ' Prompt user before deleting relation.
        If MsgBox(rel.Name & " already exists. " _
            & vbCrLf _
            & "This relation will be deleted and " _
            & "re-created.", vbOK) = vbOK 
        Then
                dbs.Relations.Delete rel.Name
            ' If user chooses Cancel, exit procedure.
            Else
                Exit Sub
            End If
        End If
    Next rel
    ' Create new relationship and set its properties.
    Set rel = dbs.CreateRelation("EmployeesOrders", "Employees", "Orders")
    ' Set Relation object attributes to enforce
    ' referential integrity.
    rel.Attributes = dbRelationDeleteCascade + _
        dbRelationUpdateCascade
    ' Create field in Fields collection of Relation object.
    Set fld = rel.CreateField("EmployeeID")
    ' Provide name of foreign key field.
    fld.ForeignName = "EmployeeID"
    ' Append field to Relation object and 
    ' Relation object to database.
    rel.Fields.Append fld
    dbs.Relations.Append rel
    MsgBox "Relation '" & rel.Name & "' created."
    Set dbs = Nothing
End Sub