Deleting and making relationships

[mohobrien]

I'm trying to update a db by copying new tables into it. Actually I've already got them in there, I just have to dance with the names.What I have is five tables in three flavors:

newtablename   - just imported to become current
tablename      - the table that was current
tablename-bkup - the previous current table

I don't know what's happening as sometimes I get error messages that the relation name can't be found and when making a new relation, relation names already exist. But I've already deleted them all. As a clue, I sometimes get relationships appearing between bkup tables, suggesting that the relationship transferred with the rename of the table!
Any comments would be welcome. This is my first crack at relationships.

Private Sub Form_Open(Cancel As Integer)

'All tables that are being copied or deleted or renamed or whatever have
'to have their relations removed first and then replaced after the operation.
Dim Myrel As Relation
Dim MyDB As Database
Dim MyFld As Field
Dim tbl1 As TableDef
Dim tbl2 As TableDef

Set MyDB = DBEngine.Workspaces(0).Databases(0)
       'delete all relations from tables
       For Each Myrel In MyDB.Relations
             Debug.Print Myrel.Name
             MyDB.Relations.Delete Myrel.Name
       Next Myrel
MyDB.Relations.Refresh

'Now, you can throw the tables around.
'if newtables have been added, then update the tables
If ObjectExists("Table", "newALLDISP") Then
   If ObjectExists("Table", "newtblDispNumOnly") Then
       If ObjectExists("Table", "newtblHolders") Then
          If ObjectExists("Table", "newtblPreviousHolders") Then
             If ObjectExists("Table", "newtblSubmission") Then
DoCmd.SetWarnings False
If ObjectExists("Table", "tblDispNumOnly-bkup") Then DoCmd.DeleteObject acTable, "tblDispNumOnly-bkup"  'delete the old backup
If ObjectExists("Table", "tblDispNumOnly") Then DoCmd.Rename "tblDispNumOnly-bkup", acTable, "tblDispNumOnly"  'rename orig to bkup
DoCmd.Rename "tblDispNumOnly", acTable, "newtblDispNumOnly" 'rename new to the active table
If ObjectExists("Table", "ALLDISP-bkup") Then DoCmd.DeleteObject acTable, "ALLDISP-bkup"  'delete the old backup
If ObjectExists("Table", "ALLDISP") Then DoCmd.Rename "ALLDISP-bkup", acTable, "ALLDISP"  'rename orig to bkup
DoCmd.Rename "ALLDISP", acTable, "newALLDISP" 'rename new to the active table
If ObjectExists("Table", "tblHolders-bkup") Then DoCmd.DeleteObject acTable, "tblHolders-bkup"  'delete the old backup
If ObjectExists("Table", "tblHolders") Then DoCmd.Rename "tblHolders-bkup", acTable, "tblHolders"  'rename orig to bkup
DoCmd.Rename "tblHolders", acTable, "newtblHolders" 'rename new to the active table
If ObjectExists("Table", "tblPreviousHolders-bkup") Then DoCmd.DeleteObject acTable, "tblPreviousHolders-bkup"  'delete the old backup
If ObjectExists("Table", "tblPreviousHolders") Then DoCmd.Rename "tblPreviousHolders-bkup", acTable, "tblPreviousHolders"  'rename orig to bkup
DoCmd.Rename "tblPreviousHolders", acTable, "newtblPreviousHolders" 'rename new to the active table
If ObjectExists("Table", "tblSubmission-bkup") Then DoCmd.DeleteObject acTable, "tblSubmission-bkup"  'delete the old backup
If ObjectExists("Table", "tblSubmission") Then DoCmd.Rename "tblSubmission-bkup", acTable, "tblSubmission"  'rename orig to bkup
DoCmd.Rename "tblSubmission", acTable, "newtblSubmission" 'rename new to the active table
DoCmd.SetWarnings True
             End If
          End If
       End If
   End If
End If

'Now to put the relations back.

 On Error GoTo alreadyexists
 ' tbl1 and tbl2 already exists as tables, you have to create an instance of their tabledef
    Set tbl1 = MyDB.TableDefs("tblDispNumOnly")
    Set tbl2 = MyDB.TableDefs("ALLDISP")
    Set Myrel = MyDB.CreateRelation("tblDispNumOnlyALLDISP", tbl1.Name, tbl2.Name, 4353)
    Myrel.Fields.Append Myrel.CreateField("DispNum") 'the primary key of the base table
    Myrel.Fields![DispNum].ForeignName = "Disposition Number"
    MyDB.Relations.Append Myrel

    Set tbl1 = MyDB.TableDefs("ALLDISP")
    Set tbl2 = MyDB.TableDefs("tblHolders")
    Set Myrel = MyDB.CreateRelation("ALLDISPtblHolders", tbl1.Name, tbl2.Name, 4352)
    Myrel.Fields.Append Myrel.CreateField("Disposition Number") 'the primary key of the base table
    Myrel.Fields![Disposition Number].ForeignName = "DispositionNumber"
    MyDB.Relations.Append Myrel

    Set tbl1 = MyDB.TableDefs("ALLDISP")
    Set tbl2 = MyDB.TableDefs("tblPreviousHolders")
    Set Myrel = MyDB.CreateRelation("ALLDISPtblPreviousHolders", tbl1.Name, tbl2.Name, 4352)
    Myrel.Fields.Append Myrel.CreateField("Disposition Number") 'the primary key of the base table
    Myrel.Fields![Disposition Number].ForeignName = "DispositionNumber"
    MyDB.Relations.Append Myrel

    Set tbl1 = MyDB.TableDefs("ALLDISP")
    Set tbl2 = MyDB.TableDefs("tblSubmission")
    Set Myrel = MyDB.CreateRelation("ALLDISPtblSubmission", tbl1.Name, tbl2.Name, 4352)
    Myrel.Fields.Append Myrel.CreateField("Disposition Number") 'the primary key of the base table
    Myrel.Fields![Disposition Number].ForeignName = "DispositionNumber"
    MyDB.Relations.Append Myrel

MyDB.Close
MyDB.Relations.Refresh
Set MyDB = Nothing
Set Myrel = Nothing
Set MyFld = Nothing
Set tbl1 = Nothing
Set tbl2 = Nothing

DoCmd.Close acForm, "startup"
DoCmd.OpenForm "Form1"
Exit Sub
alreadyexists:
If Err.Number = 3012 Then
Resume Next
Else
MsgBox "Error Number: " & Err.Number, vbCritical
End If
End Sub

 

[mohobrien]

Tried another tack

As long as there are no relationships present when I open the database, the update flows without a problem. I put the delete relations and make relations routines into a couple of public subs in the startup form. All relations are made properly. When ending a session, I tried the same thing. Open a dead shutdown form that deletes the relations. However the tables haven't been released yet as I get .....
Error 3211 The database engine couldn't lock table "tblholders" because its already in use by another person or process. Is there a workaround?