>
Function EnumerateRelation () As Integer Dim dbsExample As Database Dim tdfReferenced As TableDef, tdfReferencing As TableDef Dim fldPrimeKey As Field, idxUnique As Index, relEnforced As _ Relation Dim I As Integer ' Get database. Set dbsExample = _ DBEngine.Workspaces(0).OpenDatabase("Northwind.mdb") ' Create referenced table with primary key. Set tdfReferenced = dbsExample.CreateTableDef("Referenced") Set fldPrimeKey = tdfReferenced.CreateField("PrimaryKey", dbLong) tdfReferenced.Fields.Append fldPrimeKey ' Create unique index for enforced referential integrity. Set idxUnique = tdfReferenced.CreateIndex("UniqueIndex") idxUnique.Primary = True ' No Null values allowed. Set fldPrimeKey = tdfReferenced.CreateField("PrimaryKey") idxUnique.Fields.Append fldPrimeKey tdfReferenced.Indexes.Append idxUnique dbsExample.TableDefs.Append tdfReferenced
' Create referencing table with foreign key. Set tdfReferencing = dbsExample.CreateTableDef("Referencing") Set fldPrimeKey = tdfReferencing.CreateField("ForeignKey", dbLong) tdfReferencing.Fields.Append fldPrimeKey dbsExample.TableDefs.Append tdfReferencing ' Create one-to-many relationship and enforce referential integrity. Set relEnforced = dbsExample.CreateRelation("EnforcedOneToMany") relEnforced.Table = "Referenced" relEnforced.ForeignTable = "Referencing" ' Don't set either dbRelationUnique or dbRelationDontEnforce. relEnforced.Attributes = 0 Set fldPrimeKey = relEnforced.CreateField("PrimaryKey") fldPrimeKey.ForeignName = "ForeignKey" relEnforced.Fields.Append fldPrimeKey dbsExample.Relations.Append relEnforced ' Enumerate relation and its fields. Debug.Print "Relation: "; relEnforced.Name Debug.Print " Primary Table: "; relEnforced.Table Debug.Print " Foreign Table: "; relEnforced.ForeignTable Debug.Print " Attributes: "; relEnforced.Attributes Debug.Print "Fields in Relation: Primary, Foreign"; For I = 0 To relEnforced.Fields.Count - 1 Set fldPrimeKey = relEnforced.Fields(I) Debug.Print " "; fldPrimeKey.Name; Debug.Print ", "; fldPrimeKey.ForeignName Next I Debug.Print dbsExample.Relations.Delete "EnforcedOneToMany" dbsExample.TableDefs.Delete "Referenced" dbsExample.TableDefs.Delete "Referencing" EnumerateRelation = True End FunctionExample (Microsoft Access) The following example creates a new Relation object representing the relationship between an Employees table and an Orders table. To test the following example in Microsoft Access, open the Northwind sample database and choose Relationships from the Tools menu. Delete the relationship between the Employees table and the Orders table, and close the Relationships window. Then, run the following function from a standard module, and view the Relationships window again to see the new relationship.
Sub NewRelation() Dim dbs As Database Dim fld As Field, rel As Relation ' Return Database variable that points to current database. Set dbs = CurrentDb
' Create new relationship and set its properties. Set rel = dbs.CreateRelation("EmployeesRelation", "Employees", _ "Orders") ' Set Relation object attributes to enforce referential integrity. rel.Attributes = dbRelationDeleteCascade + 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 End Sub