MS Access – VBA – Delete Table Relationships

Sometimes, say when you wish to delete a table, you may need to delete the relationships associated with a given table. Now I’ve seen code to delete all the database relationships, but never for just a specific table. Yesterday, while trying to help in a forum I created the following procedure that does that; delete all the relationships relating to a single specified table.

'---------------------------------------------------------------------------------------
' Procedure : DeleteTableRelationships
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Delete all the relationships for the specified table
'             *Does not validate for the existence of the table
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: None required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sTable - Name of the table for which to delete all its relationships
'
' Usage:
' ~~~~~~
' Call DeleteTableRelationships("Contacts")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2020-01-07              Initial Release
'---------------------------------------------------------------------------------------
Public Function DeleteTableRelationships(sTable As String) As Boolean
    Dim db                    As DAO.Database
    Dim rel                   As DAO.Relation

    On Error GoTo Error_Handler

    Set db = CurrentDb
    For Each rel In db.Relations
        If rel.Table = sTable Or rel.ForeignTable = sTable Then
            db.Relations.Delete (rel.Name)
        End If
    Next rel
    DeleteTableRelationships = True

Error_Handler_Exit:
    On Error Resume Next
    If Not rel Is Nothing Then Set rel = Nothing
    If Not db Is Nothing Then Set db = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: DeleteTableRelationships" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

So this would be the type of function you would run prior to trying to delete a specific table.

The basic principle is very simple, loop through all the relationships (db.Relations) and for each one (rel) check and see if the specified table is used as either the Table or Foreign Table (If rel.Table = sTable Or rel.ForeignTable = sTable Then), if so then delete that relationship (db.Relations.Delete (rel.Name)), otherwise do nothing and move on to checking the next relationship.

4 responses on “MS Access – VBA – Delete Table Relationships”

  1. philippe hoyois

    Merci Daniel !
    Cette fonction très utile et qui marche du premier coup ! Idéal !

    Voici une question que j’essaie de résoudre depuis deux jours :
    J’ai une fonction simple qui transforme des tables liées en tables locales avec
    DoCmd.TransferDatabase acImport
    Malheureusement, une fois que les tables deviennent locales, elles ont perdu toutes leurs relationships.
    Existe-t-il un moyen par vba d’importer les tables AVEC leurs relationships, ou bien d’importer les relationships à la suite, sans retourner dans les accdb liés pour y jouer avec du xml ?

    Merci, bien respectueusement,

    phil

  2. Kelly Wornell

    How would you add a variable into the code so you could loop thru each table in the database and delete all relationships? I am trying to delete all tables in another database so I can then export the tables in this database for an updated version of my software.

    1. Daniel Pineault Post author

      This is untested, so be sure to create a backup of your database before trying it, but what about something like

      '---------------------------------------------------------------------------------------
' Procedure : DeleteAllDbRelationships
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Delete all the databases relationships
'             *Does not validate for the existence of the table
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: None required
'
' Usage:
' ~~~~~~
' Call DeleteAllDbRelationships
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2021-02-19              Initial Release, blog question
'---------------------------------------------------------------------------------------
Public Function DeleteAllDbRelationships() As Boolean
    Dim db                    As DAO.Database
    Dim rel                   As DAO.Relation

    On Error GoTo Error_Handler

    Set db = CurrentDb
    For Each rel In db.Relations
        db.Relations.Delete (rel.Name)
    Next rel
    DeleteAllDbRelationships = True

Error_Handler_Exit:
    On Error Resume Next
    If Not rel Is Nothing Then Set rel = Nothing
    If Not db Is Nothing Then Set db = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: DeleteAllDbRelationships" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function