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