Description
A Relation object represents a relationship between fields in tables or queries (Microsoft Jet databases only).
Remarks You can use the Relation object to create new relationships and examine existing relationships in your database. Using a Relation object and its properties, you can:See Also CreateRelation method, Foreign property.
Example This example shows how an existing Relation object can control data entry. The procedure attempts to add a record with a deliberately incorrect CategoryID; this triggers the error-handling routine.Sub RelationX()
Dim dbsNorthwind As Database
Dim rstProducts As Recordset
Dim prpLoop As Property
Dim fldLoop As Field
Dim errLoop As Error
Set dbsNorthwind = OpenDatabase("Northwind.mdb")
Set rstProducts = dbsNorthwind.OpenRecordset("Products")
' Print a report showing all the different parts of
' the relation and where each part is stored.
With dbsNorthwind.Relations!CategoriesProducts
Debug.Print "Properties of " & .Name & " Relation"
Debug.Print " Table = " & .Table
Debug.Print " ForeignTable = " & .ForeignTable
Debug.Print "Fields of " & .Name & " Relation"
With .Fields!CategoryID
Debug.Print " " & .Name
Debug.Print " Name = " & .Name
Debug.Print " ForeignName = " & .ForeignName
End With
End With
' Attempt to add a record that violates the relation.
With rstProducts
.AddNew
!ProductName = "Trygve's Lutefisk"
!CategoryID = 10
On Error GoTo Err_Relation
.Update
On Error GoTo 0
.Close
End With
dbsNorthwind.Close
Exit Sub
Err_Relation:
' Notify user of any errors that result from
' the invalid data.
If DBEngine.Errors.Count > 0 Then
For Each errLoop In DBEngine.Errors
MsgBox "Error number: " & errLoop.Number & _
vbCr & errLoop.Description
Next errLoop
End If
Resume Next
End Sub
Example (Microsoft Access)
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