Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Microsoft Access Relationships

Posted on 2006-07-22
4
Medium Priority
?
360 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 500 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

Get free NFR key for Veeam Availability Suite 9.5

Veeam is happy to provide a free NFR license (1 year, 2 sockets) to all certified IT Pros. The license allows for the non-production use of Veeam Availability Suite v9.5 in your home lab, without any feature limitations. It works for both VMware and Hyper-V environments

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Did you know that more than 4 billion data records have been recorded as lost or stolen since 2013? It was a staggering number brought to our attention during last week’s ManageEngine webinar, where attendees received a comprehensive look at the ma…
If you’re using QODBC to update QuickBooks data from Microsoft® Access but Access is not showing the updated data, you could have set up QODBC incorrectly.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
Add bar graphs to Access queries using Unicode block characters. Graphs appear on every record in the color you want. Give life to numbers. Hopes this gives you ideas on visualizing your data in new ways ~ Create a calculated field in a query: …
Suggested Courses

877 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