VBA code for creating MS Access Relations

• Download source code - 1.19 KB

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..."
    
    ''==========================
    ''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

History

None.