Public Function CreateAllRelations()
Dim db As DAO.Database
Dim totalRelations As Integer
Set db = CurrentDb()
totalRelations = db.Relations.Count
If totalRelations > 0 Then
For i = totalRelations - 1 To 0 Step -1
db.Relations.Delete (db.Relations(i).Name)
Next i
Debug.Print Trim(Str(totalRelations)) + " Relationships deleted!"
End If
Debug.Print "Creating Relations..."
''==========================
''Example
'Employee Master to Employee CheckIn
Debug.Print CreateRelation("Employee", "Code", _
"CheckIn", "Code")
''Orders to Order Details
Debug.Print CreateRelation("Orders", "No", _
"OrderDetails", "No")
''==========================
totalRelations = db.Relations.Count
Set db = Nothing
Debug.Print Trim(Str(totalRelations)) + " Relationships created!"
Debug.Print "Completed!"
End Function
Private Function CreateRelation(primaryTableName As String, _
primaryFieldName As String, _
foreignTableName As String, _
foreignFieldName As String) As Boolean
On Error GoTo ErrHandler
Dim db As DAO.Database
Dim newRelation As DAO.Relation
Dim relatingField As DAO.Field
Dim relationUniqueName As String
relationUniqueName = primaryTableName + "_" + primaryFieldName + _
"__" + foreignTableName + "_" + foreignFieldName
Set db = CurrentDb()
'Arguments for CreateRelation(): any unique name,
'primary table, related table, attributes.
Set newRelation = db.CreateRelation(relationUniqueName, _
primaryTableName, foreignTableName)
'The field from the primary table.
Set relatingField = newRelation.CreateField(primaryFieldName)
'Matching field from the related table.
relatingField.ForeignName = foreignFieldName
'Add the field to the relation's Fields collection.
newRelation.Fields.Append relatingField
'Add the relation to the database.
db.Relations.Append newRelation
Set db = Nothing
CreateRelation = True
Exit Function
ErrHandler:
Debug.Print Err.Description + " (" + relationUniqueName + ")"
CreateRelation = False
End Function