[RESOLVED] DAO CreateRelation - I Really need help with this please.

[cafeenman]

'
Essentially what I'm doing is making copies of tables (templates).

The idea is that there are books. Users can create new books (which is three tables) and then select any book they want.

The tables store Game sessions. When the user deletes old sessions I want the old data in the two linked tables to be deleted (cascade delete)

This is my text-based, multiple-choice game.

I'm having no problems creating the tables or primary keys in them. That's all working.

No matter what I do with the relationships, it fails someplace. This is failing with an error "cannot create relation with no fields defined".

This is the code.

Sub CreateRelation(ByRef Table1 As String, ByRef Index1 As String, ByRef Table2 As String, ByRef Index2 As String)
Dim Relationship As DAO.Relation
Dim tblDef1 As DAO.TableDef
Dim tblDef2 As DAO.TableDef
Dim idx1 As DAO.Index
Dim idx2 As DAO.Index


With DB

  .TableDefs.Refresh

  Set tblDef1 = .TableDefs(Table1)
  Set tblDef2 = .TableDefs(Table2)

  Set idx1 = tblDef1.Indexes(Index1)
  Set idx2 = tblDef2.Indexes(Index2)

  Set Relationship = .CreateRelation(Index1 & Index2, idx1, idx2, dbRelationDeleteCascade)

  Relationship.Fields.Append Relationship.CreateField(Index1)
  Relationship.Fields.Append Relationship.CreateField(Index2)

  Relationship.Fields(Index1).ForeignName = Index2

  .Relations.Append Relationship

End With

End Sub

This is part of the sub where it gets called.

Sub ASub

....snip

If CreateTableCopy(BOOK_TITLE_TEMPLATE, BookTitle) <> 0 Then Exit Sub

AddTableIndex BookTitle, "ChapterID", "ChapterID", False, False, True

If CreateTableCopy(POINT_INSTANCES_TEMPLATE, sPointInstances) <> 0 Then Exit Sub

AddTableIndex sPointInstances, "ChapterID", "ChapterID", False, False, True

CreateRelation BookTitle, "ChapterID", sPointInstances, "ChapterID"

If CreateTableCopy(STARTING_ATTRIBUTE_VALUES_TEMPLATE, sStartingAttributeValues) <> 0 Then Exit Sub

CreateRelation BookTitle, "ChapterID", sStartingAttributeValues, "ChapterID"

DB.TableDefs.Refresh

End Sub

[Elroy]

I do LOTS of this. I'm not sitting at my main computer right now, but I'll go over there after lunch, and post procedures where I do precisely this.

Basically, I have a quite complex MDB database that can be "re"-built from scratch with VBA code using the DAO ... and this database is full of indexes and relationships.

[Elroy]

Also, I don't entirely understand what you're doing from the OP, but I personally draw a hard line between database structure and database data.

I don't ever change the structure (tables, fields, indexes, relationships) based on what the user does. IMHO, there's always a way to design the structure in such a way that it's static (except for updates/enhancements).

[Elroy]

Ok, here are the "relationship" procedures I use. Maybe they'll help you.

However, as a note, that dbTheDatabase is expected to be opened exclusive before calling any of these procedures. In my project, that database object variable is just global to the entire project. I just declared it in the following module so I could make sure that code would at least compile in a BAS module. But, it's up to you to actually get the MDB file open.

Option Explicit

Public dbTheDatabase As DAO.Database



Public Sub DbAddRelationship(sPrimaryTableName As String, sForeignTableName As String, _
                             sPrimaryFieldNames() As String, sForeignFieldNames() As String, _
                             Optional bOneToMany As Boolean = True, _
                             Optional bEnforceIntegrity As Boolean = True, _
                             Optional bCascadeUpdates As Boolean = True, _
                             Optional bCascadeDeletes As Boolean = True)
    '
    ' Sadly, these relationships DON'T show up on the MS_Access RELATIONSHIPS window until the table is manually added to the window.
    '
    Dim lAttributes As Long
    Dim rel As DAO.Relation
    Dim fdf As DAO.Field
    Dim i As Long
    '
    ' The following are relationship attributes.
    If (Not bOneToMany) Then lAttributes = lAttributes Or dbRelationUnique              ' One-to-one relationship.
    If (Not bEnforceIntegrity) Then lAttributes = lAttributes Or dbRelationDontEnforce
    If bCascadeUpdates Then lAttributes = lAttributes Or dbRelationUpdateCascade
    If bCascadeDeletes Then lAttributes = lAttributes Or dbRelationDeleteCascade
    '
    Set rel = dbTheDatabase.CreateRelation(sPrimaryTableName & sForeignTableName)
    rel.Table = sPrimaryTableName
    rel.ForeignTable = sForeignTableName
    rel.Attributes = lAttributes
    '
    For i = LBound(sPrimaryFieldNames) To UBound(sPrimaryFieldNames)
        Set fdf = rel.CreateField(sPrimaryFieldNames(i))
        fdf.ForeignName = sForeignFieldNames(i)
        rel.Fields.Append fdf
    Next
    '
    dbTheDatabase.Relations.Append rel
    dbTheDatabase.Relations.Refresh
End Sub

Public Function DbRelationshipFieldsCount(sPrimaryTableName As String, sForeignTableName As String) As Long
    ' Returns zero if relationship not found.
    '
    Dim i As Long
    For i = 0 To dbTheDatabase.Relations.Count - 1
        If dbTheDatabase.Relations(i).Table = sPrimaryTableName And _
           dbTheDatabase.Relations(i).ForeignTable = sForeignTableName Then
            DbRelationshipFieldsCount = dbTheDatabase.Relations(i).Fields.Count
            Exit Function
        End If
    Next
    ' It drops out if the relationship was not found.
End Function

Public Sub DbDeleteRelationship(sPrimaryTableName As String, sForeignTableName As String)
    Dim i As Long
    Dim sRelationName As String
    '
    For i = 0 To dbTheDatabase.Relations.Count - 1
        If dbTheDatabase.Relations(i).Table = sPrimaryTableName And _
           dbTheDatabase.Relations(i).ForeignTable = sForeignTableName Then
            sRelationName = dbTheDatabase.Relations(i).Name
            dbTheDatabase.Relations.Delete sRelationName
            dbTheDatabase.Relations.Refresh
            Exit Sub
        End If
    Next
    ' It drops out without notice if the relationship was not found.
End Sub

Public Sub DeleteAndAddRelationship(sPrimaryTableName As String, sForeignTableName As String, _
                                     sPrimaryFieldNames() As String, sForeignFieldNames() As String)
    '
    If DbRelationShipExists(sPrimaryTableName, sForeignTableName) Then DbDeleteRelationship sPrimaryTableName, sForeignTableName
    DbAddRelationship sPrimaryTableName, sForeignTableName, sPrimaryFieldNames(), sForeignFieldNames()
End Sub

Public Function DbRelationShipExists(sPrimaryTableName As String, sForeignTableName As String) As Boolean
    Dim i As Long
    '
    For i = 0 To dbTheDatabase.Relations.Count - 1
        If dbTheDatabase.Relations(i).Table = sPrimaryTableName And _
           dbTheDatabase.Relations(i).ForeignTable = sForeignTableName Then
            '
            DbRelationShipExists = True
            Exit Function
        End If
    Next
    ' If we fell out, it returns False.
    DbRelationShipExists = False
End Function

[cafeenman]

' Sadly, these relationships DON'T show up on the MS_Access RELATIONSHIPS window until the table is manually added to the window.

That same thing happens when I create a table in code.

If I have Access open, the table doesn't show up but the code won't let me create the table a second time because I already created it.

I just have to refresh table defs in the code and if I'm in Access, just go to one of the other tabs and back to tables - e.g. go to queries, then back to tables. And there the table is.

Thanks for the code. I'll try it out.

[cafeenman]

Oh, wait.... yeah. that also happens to me with the relationships window. I think it's meant to be like that.

I might have dozens of relationships in a db but I might delete most of the tables out of the relationships window because I don't need to see them and they're cluttering everything up.

[Elroy]

Oh, wait.... yeah. that also happens to me with the relationships window. I think it's meant to be like that.

I might have dozens of relationships in a db but I might delete most of the tables out of the relationships window because I don't need to see them and they're cluttering everything up.

YES! Just because you have relationships, doesn't mean that they "appear" on the relationships window in MS-Access. Sorry, I didn't realize that's all that was happening. Just throw the tables onto that MS-Access relationships window, and your new relationships will appear (but I think you now have that figured out).

[cafeenman]

That's not the problem. The code fails when I try to create the relationship. It's not getting it done.

But I'm going to mark this resolved. I had my tables mixed up.

I only need to create one and it doesn't need a relationship with anything.

I was conflating it with another table that does.

So it would be good information, but now I realize I don't even need to do it.

Thanks.