ForeignName, ForeignTable, Table Properties Example (MDB)

The following example shows how you can use the ForeignName, ForeignTable, and Table properties when you create a relationship between two existing tables — in this case, Employees (the primary table) and Orders (the foreign table) in the current database. EmployeeID is the primary key in the Employees table, and also a foreign key in the Orders table. The relationship is one-to-many and referential integrity is enforced.

Note that the And operator performs a bitwise comparison to determine what permissions are currently set.

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 & "The 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")
    ' Set Table property.
    rel.Table = "Employees"
    ' Set ForeignTable property.
    rel.ForeignTable = "Orders"
    ' Set Relation object attributes to enforce
    ' referential integrity.
    rel.Attributes = dbRelationDeleteCascade And _
        dbRelationUpdateCascade
    ' Create field in Fields collection of Relation.
    Set fld = rel.CreateField("EmployeeID")
    ' Provide name of foreign key field.
    fld.ForeignName = "EmployeeID"
    ' Append field to Relation and Relation to database.
    rel.Fields.Append fld
    dbs.Relations.Append rel
    MsgBox "Relation '" & rel.Name & "' created."
    Set dbs = Nothing
End Sub