Solved

Microsoft Access Relationships

Posted on 2006-07-22
4
346 Views
Last Modified: 2008-09-09
I have modified a function that I found to print out in plain english the relationships in my database. The function creates a table that has:
1. Relation name
2. Relation table
3. Relation Foreign table
4. Relation Attribute
5. Relation Field
6. Relation Foreign field

It works fine, but the Relation Attribute is a number. I want all of the information that number represents such as INNER JOIN, LEFT JOIN, One-To-One, One-To-Many, Indeterminate, Enforce Referential Integrity/CascadeUpdate/CascadeDelete.

How can I retrieve that information. Here is my function. You could run it on a database to see what I mean. A secondary function is also necessary and is below the main function.

Option Compare Database
Option Explicit

Function CurrentRelations(DbName As String) As Integer
'------------------------------------------------------------------
' PURPOSE: Create table with current database relationships.
' ACCEPTS: The name of the current database as a string.
' RETURNS: The number of relationships in current database
'          as an integer.
' DbName in Function must be full path of this database.
' REQUIRES: A Reference to Microsoft DAO 3.6 Object Library
'           in the database. To make sure you have it installed
'           click on Tools/References at the top of this page.
'           If you do not see a check mark next to
'           Microsoft DAO 3.6 Object Library then check the box
'           and click OK before running the program.
'------------------------------------------------------------------
Dim ThisDb As DAO.Database
Dim ThisRel As DAO.Relation
Dim ThisField As DAO.Field
Dim Cr As String, I As Integer, cnt As Integer, RCount As Integer
Dim j As Integer
Dim ErrBadField As Integer
Dim Path As String
Dim DoesItExist As Boolean
Dim strNameObject As String

Dim objTablesQueries As AccessObject, dbsTablesQueries As Object
Set dbsTablesQueries = Application.CurrentData
Path = GetFullPath
Cr$ = Chr$(13)
RCount = 0

DoEvents
Path = GetFullPath 'This
DoesItExist = False
    For Each objTablesQueries In dbsTablesQueries.AllTables
        strNameObject = objTablesQueries.Name
    If strNameObject = "tblCurrentDBRelationships" Then
    DoesItExist = True
    End If
    Next objTablesQueries
If DoesItExist = True Then
DoCmd.DeleteObject acTable, "tblCurrentDBRelationships"
End If
DoesItExist = False
DoCmd.RunSQL "CREATE TABLE tblCurrentDBRelationships (ID AUTOINCREMENT UNIQUE PRIMARY KEY, ThisRelName TEXT(255), " _
& "ThisRelTable TEXT(255), ThisRelForeignTable TEXT(255), ThisRelAttributes LONG, " _
& "ThisFieldName TEXT(255), ThisFieldForeignName TEXT(255)" & ");"

Set ThisDb = CurrentDb()

' Loop through all existing relationships in the current database.
For I = 0 To ThisDb.Relations.Count - 1
   Set ThisRel = ThisDb.Relations(I)

   ' Set bad field flag to false.
   ErrBadField = False

   ' Loop through all fields in that relation.
   For j = 0 To ThisRel.Fields.Count - 1
      Set ThisField = ThisRel.Fields(j)

      ' Check for bad fields.
      On Error Resume Next
      If Err <> False Then ErrBadField = True
      On Error GoTo 0
   Next j

   ' If any field of this relationship caused an error,
   ' do not add this relationship.
   If ErrBadField = True Then
      ' Something went wrong with the fields.
      ' Do not do anything.
   Else
      ' Try to append the relation.
      On Error Resume Next
      If Err <> False Then
         ' Something went wrong with the relationship.
         ' Skip it.
      Else
         ' Keep count of successful imports.
         RCount = RCount + 1
      End If
      On Error GoTo 0
   End If

DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO tblCurrentDBRelationships ( ThisRelName, ThisRelTable, " _
           & "ThisRelForeignTable, ThisRelAttributes, " _
           & "ThisFieldName, ThisFieldForeignName ) " _
           & "VALUES " _
           & "( " & Chr$(34) & ThisRel.Name & Chr$(34) & ", " _
           & Chr$(34) & ThisRel.Table & Chr$(34) & ", " _
           & Chr$(34) & ThisRel.ForeignTable & Chr$(34) & ", " _
           & ThisRel.Attributes & ", " _
           & Chr$(34) & ThisField.Name & Chr$(34) & ", " & Chr$(34) & ThisField.ForeignName & Chr$(34) & " )"
DoCmd.SetWarnings True

Next I

' Close databases.
ThisDb.Close

' Return number of successful current relations.
CurrentRelations = RCount

End Function

Option Compare Database
Option Explicit

Function GetFullPath()
   'Returns full path including file to currently opened MDB or ADP
   GetFullPath = CurrentProject.FullName
End Function

Function GetPath()
   'Returns the path to currently opened MDB or ADP
   GetPath = CurrentProject.Path
End Function

Function GetName()
   'Returns the filename of the currently opened MDB or ADP
   GetName = CurrentProject.Name
End Function
0
Comment
Question by:Emil_Gray
  • 3
4 Comments
 
LVL 13

Expert Comment

by:John Mc Hale
ID: 17162318
This might start you off:

The Relationships Attribute appears to be a 32-bit Integer (Long integer)

Bit
0              If this is set (1), then Relationship is 1:1
1              If this is set, then, while a relationship exists, it is indeterminate
2              If this is set, then target is a linked MS Access Table? (not too sure if this is absolutely correct)
8              If this is set, then Cascade Updates
12            If this is set, then Cascade Deletes
24            If this is set, then LEFT JOIN
25            If this is set, then RIGHT JOIN

So, a 1:1 relationship with integrity enforced cascading updates and deletes would be
2^0 + 2^8 + 2^12 = 1 + 0 + 256 + 4096 = 4353


A Left Outer Join 1:N, on an indeterminate relationship (or to an external non-Access table) would be
2^1 + 2^24 = 2 + 16777216 = 16777218

A Right Outer Join 1:1, on a linked MS Access Table with Referential Integrity enforced, Cascading Updates and Deletes would be
2^0 + 2^2 + 2^8 + 2^12 + 2^25 = 1 + 4 + 256 + 4096 + 33554432 = 33558789

I think theses are the most important bits to mask out, at least they will be able to tell you the Type of Join, Whether or not Integrity is being enforced, and if so, whether or not Updates/Deletes are being cascaded. Bit 0 will also tell you if the relationship is 1:1 (set) or 1:N (unset)

Regards.  
 
0
 
LVL 13

Accepted Solution

by:
John Mc Hale earned 125 total points
ID: 17162413
A copy of your CurrentRelations function, that adds an extra Attribute Translation field to the output table:


Public Function CurrentRelations(DbName As String) As Integer
'------------------------------------------------------------------
' PURPOSE: Create table with current database relationships.
' ACCEPTS: The name of the current database as a string.
' RETURNS: The number of relationships in current database
'          as an integer.
' DbName in Function must be full path of this database.
' REQUIRES: A Reference to Microsoft DAO 3.6 Object Library
'           in the database. To make sure you have it installed
'           click on Tools/References at the top of this page.
'           If you do not see a check mark next to
'           Microsoft DAO 3.6 Object Library then check the box
'           and click OK before running the program.
'------------------------------------------------------------------
Dim ThisDb As DAO.Database
Dim ThisRel As DAO.Relation
Dim ThisField As DAO.Field
Dim Cr As String, I As Integer, cnt As Integer, RCount As Integer
Dim j As Integer
Dim ErrBadField As Integer
Dim Path As String
Dim DoesItExist As Boolean
Dim strNameObject As String
Dim lngAttributes As Long
Dim strCardinality As String
Dim strRelType As String
Dim strLinkedAccessTable As String
Dim strCasUpdate As String
Dim strCasDelete As String
Dim strJoinType As String
Dim strAttributes As String

Dim objTablesQueries As AccessObject, dbsTablesQueries As Object
Set dbsTablesQueries = Application.CurrentData
Path = GetFullPath
Cr$ = Chr$(13)
RCount = 0

DoEvents
Path = GetFullPath 'This
DoesItExist = False
    For Each objTablesQueries In dbsTablesQueries.AllTables
        strNameObject = objTablesQueries.Name
    If strNameObject = "tblCurrentDBRelationships" Then
    DoesItExist = True
    End If
    Next objTablesQueries
If DoesItExist = True Then
DoCmd.DeleteObject acTable, "tblCurrentDBRelationships"
End If
DoesItExist = False
DoCmd.RunSQL "CREATE TABLE tblCurrentDBRelationships (ID AUTOINCREMENT UNIQUE PRIMARY KEY, ThisRelName TEXT(255), " _
& "ThisRelTable TEXT(255), ThisRelForeignTable TEXT(255), ThisRelAttributes LONG, ThisRelAttributesTranslated TEXT(255), " _
& "ThisFieldName TEXT(255), ThisFieldForeignName TEXT(255)" & ");"

Set ThisDb = CurrentDb()

' Loop through all existing relationships in the current database.
For I = 0 To ThisDb.Relations.Count - 1
   Set ThisRel = ThisDb.Relations(I)

   ' Set bad field flag to false.
   ErrBadField = False

   ' Loop through all fields in that relation.
   For j = 0 To ThisRel.Fields.Count - 1
      Set ThisField = ThisRel.Fields(j)

      ' Check for bad fields.
      On Error Resume Next
      If Err <> False Then ErrBadField = True
      On Error GoTo 0
   Next j

   ' If any field of this relationship caused an error,
   ' do not add this relationship.
   If ErrBadField = True Then
      ' Something went wrong with the fields.
      ' Do not do anything.
   Else
      ' Try to append the relation.
      On Error Resume Next
      If Err <> False Then
         ' Something went wrong with the relationship.
         ' Skip it.
      Else
         ' Keep count of successful imports.
         RCount = RCount + 1
      End If
      On Error GoTo 0
   End If
   
lngAttributes = ThisRel.Attributes
strCardinality = "Cardinality(1:" & IIf((lngAttributes And &H1) = 1, "1", "N") & ")"
strRelType = IIf((lngAttributes And &O2) = 2, "Relationship External/Indeterminate", "Enforced Referential Integrity")
strLinkedAccessTable = "Linked Access Table = " & CStr(CBool((lngAttributes And &H4) = 4))
strCasUpdate = "Cascade Updates = " & CStr(CBool((lngAttributes And &H100) = 256))
strCasDelete = "Cascade Deletes = " & CStr(CBool((lngAttributes And &H1000) = 4096))
strJoinType = "Join Type is " & IIf(((lngAttributes And &H1000000) = 16777216), "LEFT", _
IIf(((lngAttributes And &H2000000) = 33554432), "RIGHT", "INNER"))
strAttributes = strLinkedAccessTable & ";" & strCardinality & ";" & strRelType & ";" & strCasUpdate & ";" & strCasDelete & ";" & strJoinType

DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO tblCurrentDBRelationships ( ThisRelName, ThisRelTable, " _
           & "ThisRelForeignTable, ThisRelAttributes, ThisRelAttributesTranslated, " _
           & "ThisFieldName, ThisFieldForeignName ) " _
           & "VALUES " _
           & "( " & Chr$(34) & ThisRel.Name & Chr$(34) & ", " _
           & Chr$(34) & ThisRel.Table & Chr$(34) & ", " _
           & Chr$(34) & ThisRel.ForeignTable & Chr$(34) & ", " _
           & ThisRel.Attributes & ", " _
           & Chr$(34) & strAttributes & Chr$(34) & ", " _
           & Chr$(34) & ThisField.Name & Chr$(34) & ", " & Chr$(34) & ThisField.ForeignName & Chr$(34) & " )"
DoCmd.SetWarnings True

Next I

' Close databases.
ThisDb.Close

' Return number of successful current relations.
CurrentRelations = RCount

End Function
0
 
LVL 8

Author Comment

by:Emil_Gray
ID: 18189700
fredthered

Thanks. You did a great job answering my question. Microsoft did a bad job w/multiple reasons for the same code, i.e. "it could be this or it could be that".
0
 
LVL 13

Expert Comment

by:John Mc Hale
ID: 18189724
Nothing like a bit of 'digging around'.

Glad to help, and thanks for the points.

Happy Christmas (or Holidays) :)
0

Featured Post

Comprehensive Backup Solutions for Microsoft

Acronis protects the complete Microsoft technology stack: Windows Server, Windows PC, laptop and Surface data; Microsoft business applications; Microsoft Hyper-V; Azure VMs; Microsoft Windows Server 2016; Microsoft Exchange 2016 and SQL Server 2016.

Join & Write a Comment

Introduction When developing Access applications, often we need to know whether an object exists.  This article presents a quick and reliable routine to determine if an object exists without that object being opened. If you wanted to inspect/ite…
Introduction The Visual Basic for Applications (VBA) language is at the heart of every application that you write. It is your key to taking Access beyond the world of wizards into a world where anything is possible. This article introduces you to…
Using Microsoft Access, learn some simple rules for how to construct tables in a relational database. Split up all multi-value fields into single values: Split up fields that belong to other things into separate tables: Make sure that all record…
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now