SQL for Query to list Relationships in Access database + VBA function

Quick Jump

Download

Download zipped BAS file that you can import with a function to expand the relationships flags into readable text: mod_GetRelationshipType_SQL_s4p__BAS.zip

If you have trouble with the downloads, you may need to unblock the ZIP file, aka remove Mark of the Web, before extracting the file. Here are steps to do that: https://msaccessgurus.com/MOTW_Unblock.htm

VBA

Standard module

Put this function into a standard module so you can use it in an SQL statement, like for a query to find out more about relationships in your database. Compile and Save before using.

'*************** Code Start *****************************************************
' module name: mod_GetRelationshipType_SQL_s4p
'-------------------------------------------------------------------------------
' Purpose  : get the relationship type in words with long or short descriptions
'              from a mask with flag bits
'              in MsysRelations, this is called grbit
'              in DAO, this is Relation.Attributes
' Author   : crystal (strive4peace)
' Code List: https://msaccessgurus.com/code.htm
' This code: https://msaccessgurus.com/VBA/Query_SQL_ShowRelationships.htm
' LICENSE  :
'   You may freely use and share this code, but not sell it.
'   Keep attribution. Mark changes. Use at your own risk.
'-------------------------------------------------------------------------------

Public Function GetRelationshipType_s4p( _ 
   pnAttribute As Long _ 
   ,Optional pbShort As Boolean = False) _ 
   As String 

'240422 strive4peace, thanks to Adrian (NeoPa) for help with masks, 240430, 508
'return a string with the description of a relationship type
   'PARAMETERS
   ' pnAttribute is called "grbit" in MSysRelationships
   '  and is a bitmask of flags
   ' pbShort = True for a short description of each flag
   '           Default=False

   Dim sDescription As String 

   sDescription =  ""
   If pnAttribute <> 0 Then  'actually only positive
      'noRI, dbRelationDontEnforce =2
      If (pnAttribute And dbRelationDontEnforce) = dbRelationDontEnforce Then 
         sDescription = IIf(pbShort, "NoRI ", "No Enforce, ")   'NoIntegrity
      Else 
         sDescription = IIf(pbShort, "RI ", "Referential Integrity, ") 
         
         'Unique, dbRelationUnique =1
         If (pnAttribute And dbRelationUnique) = dbRelationUnique Then 
            sDescription = sDescription _ 
               & IIf(pbShort, "U ", "Unique, ")   '1 to 1
         End If 
         'CascadeUpdate, dbRelationUpdateCascade =256
         If (pnAttribute And dbRelationUpdateCascade) = dbRelationUpdateCascade Then 
            sDescription = sDescription _ 
               & IIf(pbShort, "CasUp ", "Cascade Update, ") 
         End If 
         'CascadeDelete, dbRelationDeleteCascade =4096
         If (pnAttribute And dbRelationDeleteCascade) = dbRelationDeleteCascade Then 
            sDescription = sDescription _ 
               & IIf(pbShort, "CasDel ", "Cascade Delete, ") 
         End If 
         'Cascade to Null, dbRelationCascadeNull = 8192
         ' constant not recognized in Access but can be defined with code
         If (pnAttribute And 8192) = 8192 Then 
            sDescription = sDescription _ 
               & IIf(pbShort, "CasNull ", "Cascade Null, ") 
         End If 
         
      End If 
   ElseIf pnAttribute = 0 Then  'zero 0
      sDescription = IIf(pbShort, "RI ", "Referential Integrity, ") 
   End If  ' pnAttribute >= 0 'no negative numbers

   'Left, dbRelationLeft =16777216
   If (pnAttribute And dbRelationLeft) = dbRelationLeft Then 
      sDescription = sDescription _ 
               & IIf(pbShort, "L ", "Left Join, ") 
   'Right, dbRelationRight =33554432
   ElseIf (pnAttribute And dbRelationRight) = dbRelationRight Then 
      sDescription = sDescription _ 
               & IIf(pbShort, "R ", "Right Join, ") 
   End If 
   'Inherited, dbRelationInherited =4
   If (pnAttribute And dbRelationInherited) = dbRelationInherited Then 
      sDescription = sDescription _ 
               & IIf(pbShort, "Inh ", "Inherited, ") 
   End If 
   
   'remove trailing character(s)
   If pbShort Then  ' space
      sDescription = Left(sDescription,Len(sDescription) - 1) 
   Else  ' comma and space
      sDescription = Left(sDescription,Len(sDescription) - 2) 
   End If 
   
   'string with descriptions
   GetRelationshipType_s4p = sDescription 

End Function 

'*************** Code End *******************************************************

SQL

EXAMPLE SQL - to copy and use:

1. Compile and save module with GetRelationshipType_s4p function
2. Make a new query with this SQL
3. Run! query and best-fit columns
4. Save query as qShowRelationships or whatever

Do this in the database where the relationships are defined. It's sorted by parent table, child table, relationship name and then column number.

The column number, if relationship has more than one pair of fields, ColNbr (icolumn), is zero-based whereas the number of columns, CountCols (ccolumn) is 1-based.

The GetRelationshipType_s4p function is used twice, once to show a descriptive relationship type, and once to show a shorter, abbreviated value.

SELECT m.szReferencedObject AS Table_Parent
   , m.szObject AS Table_Child
   , m.szReferencedColumn AS Field_Parent
   , m.szColumn AS Field_Child
   , m.icolumn AS ColNbr
   , m.ccolumn AS CountCols
   , m.grbit AS RelFlags
   , GetRelationshipType_s4p([grbit]) AS RelationshipType
   , GetRelationshipType_s4p([grbit], True) AS RelType
   , m.szRelationship AS RelName
  FROM MSysRelationships AS m
  WHERE (((m.szReferencedObject) Not Like "MSys*"))
  ORDER BY m.szReferencedObject
   , m.szObject
   , m.szRelationship
   , m.icolumn;

Results

qRelationships_s4p

This is run on MyContacts, which is a free download from MsAccessGurus for keeping track of contact information

Steps to create a new query from SQL

1. Create ribbon
2. from Queries group, choose Query Design
3. right-click in top pane for sources and, from shortcut menu choose SQL View, or switch to SQL View using the Home or Query Design ribbon
4. copy the SQL and paste
   be sure not to keep any characters before the word SELECT, or after the terminating semi-colon ;
5. switch to Datasheet View to look at results
6. save the query if you want

Goto Top  

Goto Top