VBA Create Delete relationships

[PhilOfWalton]

I need to delete relationships using VBA so that I can delete the linked tables, then link different tables and re-create the relationship.

This is the code I use to create the relationship

Sub CreateRelation(RelName As String, TabPrime As String, TabForeign As String, FldPrime As String, FldForeign As String)
 
    Dim MyDb As DAO.Database
    Dim Rel As DAO.Relation
    Dim Fld As DAO.Field
 
    On Error GoTo CreateRelationDAO_Err
 
    'Initialize
    Set MyDb = CurrentDb()
 
    ' Check if relationship already there
    For Each Rel In MyDb.Relations
        If Rel.Name = RelName Then
            Exit Sub
        End If
    Next Rel
 
    'Create a new relation.
    Set Rel = MyDb.CreateRelation(RelName)
 
    'Define its properties.
    With Rel
        'Specify the primary table.
        .Table = TabPrime
        'Specify the related table.
        .ForeignTable = TabForeign
        'Specify attributes for cascading updates and deletes.
        .Attributes = 3
 
        'Add the fields to the relation.
        'Field name in primary table.
        Set Fld = .CreateField(FldPrime)
        'Field name in related table.
        Fld.ForeignName = FldForeign
        'Append the field
        .Fields.Append Fld
 
        'Repeat for other fields if a multi-field relation.
    End With
 
    'Save the newly defined relation to the Relations collection.
    MyDb.Relations.Append Rel
 
CreateRelationDAO_Exit:
    'Clean up
    Set Fld = Nothing
    Set Rel = Nothing
    Set MyDb = Nothing
    'Debug.Print "Relation created."
 
    Exit Sub
 
CreateRelationDAO_Err:
    el = Erl
    en = Err.Number
    ed = Err.Description
    ctrlfnctnm = "GetDescription"
    Call Form_Err(en, ed, ctrlfnctnm, el, errMsgStr)
    Resume CreateRelationDAO_Exit
 
End Sub
 

Here is the relationship window, and there are 2 copies of TblJoinComputerBranchTblComputers

It would appear that if the tables are local, I get line 4 as expected. using the code

    CreateRelation "TblJoinComputerBranchTblComputers", "TblJoinComputerBranch", _
    "TblComputers", "ComputerID", "ComputerID"
 

Assuming my FE is on Computer 1, TblComputers on Computer2 and TblJoinComputerBranch on Computer3 ... Don't ask
it would appear Access creates it's own name for the relationship as on line 1 (Difficult to see) but it is
{C40F1BCB-C7D2-4ED0-8DFF-EADBF5B7E583}

This code works to delete the relationship created with my name

Function DeleteRelationship(RelName As String)
'   DeleteRelationship ("TblJoinComputerBranchTblComputers")
    On Error GoTo DeleteRelationship_Err
 
    Dim MyDb As DAO.Database
    Set MyDb = CurrentDb
    MyDb.Relations.Delete RelName
    Set MyDb = Nothing
 
DeleteRelationship_Exit:
    Exit Function
 
DeleteRelationship_Err:
    If Err = 3265 Then                  ' Relationship doesn't exist
        Resume DeleteRelationship_Exit
    Else
        el = Erl
        en = Err.Number
        ed = Err.Description
        ctrlfnctnm = "RElationship"
        Call Form_Err(en, ed, ctrlfnctnm, el, errMsgStr)
        Resume DeleteRelationship_Exit
    End If
 
End Function
 

I appreciate the picture of the table is not very clear but the only difference between line 1 and line 4 is in the last column where on line 1 it is:

{C40F1BCB-C7D2-4ED0-8DFF-EADBF5B7E583}

and on Line 4 it is:

TblJoinComputerBranchTblComputers

My problem is deleting the
{C40F1BCB-C7D2-4ED0-8DFF-EADBF5B7E583} relationship.

How do I find the name or do I have to trawl through the MSysRelationships table to match the names of the 4 fields that I do know and delete them.

Sorry this post is so long winded.

Phil

[ADezii]

1. Tom, while deal with confusing Relationship Names at all? Why not simply pass the 2 Table Names involved in a Relationship to a Public Function, in any order, that will do the dirty work for you? The Function will return a Boolean Value indicating Success or Failure. As an example, I created a Code Segment that will DELETE the Relationship between the Orders and Shippers Tables in the Northwind Sample DB without knowing the Name of the Relationship.
2. Function Definition:
   

   Public Function fDELETERelationship(strTable1 As String, strTable2 As String) As Boolean
   On Error GoTo Err_fDELETERelationship
   Dim rel As DAO.Relation
    
   For Each rel In CurrentDb.Relations
     If (rel.Table = strTable1 And rel.ForeignTable = strTable2) Or _
        (rel.Table = strTable2 And rel.ForeignTable = strTable1) Then
          CurrentDb.Relations.Delete rel.Name
     End If
   Next
    
   fDELETERelationship = True
    
   Exit_fDELETERelationship:
     Exit Function
    
   Err_fDELETERelationship:
     fDELETERelationship = False
       MsgBox Err.Description, vbExclamation, "Error in fDELETERelationship()"
         Resume Exit_fDELETERelationship
   End Function
    

3. Sample Function Call:
   

   If fDELETERelationship("Orders", "Shippers") Then
     MsgBox "Relationship has been DELETED!"
   Else
     MsgBox "Relationship has NOT been DELETED!"
   End If
    

4. OR
   

   If fDELETERelationship("Shippers", "Orders") Then
     MsgBox "Relationship has been DELETED!"
   Else
     MsgBox "Relationship has NOT been DELETED!"
   End If
    

[zmbd]

ADezii, very nice... I have read thru most if not all of the tabledef and relationship objects for something better and of course the SQL ALTER TABLE doesn't work on linked tables - IMHO, at this point in time, you have the only tool in the shop for the task at hand!

[PhilOfWalton]

Sweet, thanks a lot

Phil

[ADezii]

Thanks for the compliment, zmbd - glad it worked out for you, Phil.

P.S. - Not really that critical, but I would probably set the Return Value of the Function = True and exit the For...Next Loop after

CurrentDb.Relations.Delete rel.Name

[NeoPa]

Nice one ADezii. Long in the tooth but you've still got it :-)

[ADezii]

@NeoPa:
Was wondering how you have been, hopefully all is well. Always nice to hear from an old friend (the old not meant literally!).