Solved

Microsoft Access Relationships

Posted on 2006-07-22
4
353 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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

Complete VMware vSphere® ESX(i) & Hyper-V Backup

Capture your entire system, including the host, with patented disk imaging integrated with VMware VADP / Microsoft VSS and RCT. RTOs is as low as 15 seconds with Acronis Active Restore™. You can enjoy unlimited P2V/V2V migrations from any source (even from a different hypervisor)

Question has a verified solution.

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

In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
Phishing attempts can come in all forms, shapes and sizes. No matter how familiar you think you are with them, always remember to take extra precaution when opening an email with attachments or links.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Familiarize people with the process of retrieving data from SQL Server using an Access pass-thru query. Microsoft Access is a very powerful client/server development tool. One of the ways that you can retrieve data from a SQL Server is by using a pa…

733 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