Introduction
The following article describes how to create relationships in MS Access using a VBA macro.
Background
I always had a difficult time creating and managing Relationships in MS Access databases using the Relationships window. Especially when you have a lot of tables and Relations between them. My search in Google and CodeProject didn't help me, and finally, I developed this VB macro to automate Relationships.
Using the code
The code is very straightforward.
Download the zip file (RelationshipCreator.zip - 1.19 KB). Unzip and add it to your MS Access database as a module.
The main function is CreateAllRelations()
, which calls the function CreateRelation()
. As shown in the example below, you need to call the function CreateRelation()
with the following parameters -- base table's name, field name in the base table, foreign table name, and field name in the foreign table. Repeat this for each of the Relations you want to create. The main function first deletes all the Relations and then creates them all again.
Typing this for each Relation may be tedious. But once you have this, you can remove and create the Relationships any number of times by just running the macro function named CreateAllRelations()
.
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..."
Debug.Print CreateRelation("Employee", "Code", _
"CheckIn", "Code")
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()
Set newRelation = db.CreateRelation(relationUniqueName, _
primaryTableName, foreignTableName)
Set relatingField = newRelation.CreateField(primaryFieldName)
relatingField.ForeignName = foreignFieldName
newRelation.Fields.Append relatingField
db.Relations.Append newRelation
Set db = Nothing
CreateRelation = True
Exit Function
ErrHandler:
Debug.Print Err.Description + " (" + relationUniqueName + ")"
CreateRelation = False
End Function
History
None.