• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 101
  • Last Modified:

MS Access List All Tables that Do Not Have Relationships

Hi,
Is there a way to list all tables in an MS Access database that do not have relationships ?
Your assistance is greatly appreciated.
Kind Regards,
Mohamed
0
Mohamed Singh
Asked:
Mohamed Singh
  • 4
  • 3
1 Solution
 
aikimarkCommented:
Are you trying to identify the explicit relationships (defined in the UI) or the implicit relationships (established in queries)?
0
 
aikimarkCommented:
For explicit relationships, use this:
Option Explicit


Sub Q_28595093()
    Dim rel As Relation
    Dim dbRels As Relations
    Dim dicUnique As Object
    Dim tbl As TableDef
    
    Set dicUnique = CreateObject("scripting.dictionary")
    Set dbRels = DBEngine(0)(0).Relations
    For Each rel In dbRels
        If dicUnique.Exists(rel.Table) Then
            dicUnique.Exists(rel.Table) = dicUnique.Exists(rel.Table) + 1
        Else
            dicUnique.Add rel.Table, 1
        End If
        If dicUnique.Exists(rel.ForeignTable) Then
            dicUnique.Exists(rel.ForeignTable) = dicUnique.Exists(rel.ForeignTable) + 1
        Else
            dicUnique.Add rel.ForeignTable, 1
        End If
    Next
    For Each tbl In DBEngine(0)(0).TableDefs
        If dicUnique.Exists(tbl.Name) Then
        Else
            Debug.Print tbl.Name, "has no defined relation"
        End If
    Next
End Sub

Open in new window

0
 
Mohamed SinghAuthor Commented:
Hi aikimark,

Thank You responding.
My apologies for my delayed response.

I'm trying to identify tables which do not have explicit relationships.

I tried running your code but get error:

Run-time error '451':
Property let procedure not defined and property get procedure did not return an object

on line 19

Kind Regards,
Mohamed
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
aikimarkCommented:
Oops.  Please test this version:
Option Explicit


Sub Q_28595093()
    Dim rel As Relation
    Dim dbRels As Relations
    Dim dicUnique As Object
    Dim tbl As TableDef
    
    Set dicUnique = CreateObject("scripting.dictionary")
    Set dbRels = DBEngine(0)(0).Relations
    For Each rel In dbRels
        If dicUnique.Exists(rel.Table) Then
            dicUnique.Exists(rel.Table) = dicUnique.Exists(rel.Table) + 1
        Else
            dicUnique.Add rel.Table, 1
        End If
        If dicUnique.Exists(rel.ForeignTable) Then
            dicUnique.Exists(rel.ForeignTable) = dicUnique(rel.ForeignTable) + 1
        Else
            dicUnique.Add rel.ForeignTable, 1
        End If
    Next
    For Each tbl In DBEngine(0)(0).TableDefs
        If dicUnique.Exists(tbl.Name) Then
        Else
            Debug.Print tbl.Name, "has no defined relation"
        End If
    Next
End Sub

Open in new window

0
 
Mohamed SinghAuthor Commented:
Hi aikimark,
Again, my apologies for the very late response - the new year has loads of things to get done!
Thank You for this second post.
Regrettably,the same error now occurs on line 14.
Kind Regards,
Mohamed
0
 
aikimarkCommented:
One more try:
Option Explicit


Sub Q_28595093()
    Dim rel As Relation
    Dim dbRels As Relations
    Dim dicUnique As Object
    Dim tbl As TableDef
    
    Set dicUnique = CreateObject("scripting.dictionary")
    Set dbRels = DBEngine(0)(0).Relations
    For Each rel In dbRels
        If dicUnique.Exists(rel.Table) Then
            dicUnique(rel.Table) = dicUnique(rel.Table) + 1
        Else
            dicUnique.Add rel.Table, 1
        End If
        If dicUnique.Exists(rel.ForeignTable) Then
            dicUnique(rel.ForeignTable) = dicUnique(rel.ForeignTable) + 1
        Else
            dicUnique.Add rel.ForeignTable, 1
        End If
    Next
    For Each tbl In DBEngine(0)(0).TableDefs
        If dicUnique.Exists(tbl.Name) Then
        Else
            Debug.Print tbl.Name, "has no defined relation"
        End If
    Next
End Sub

Open in new window

0
 
Mohamed SinghAuthor Commented:
Hi aikimark,

Many Thanks - No errors.
Please excuse the very very delayed response.

Kindest Regards,
Mohamed
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 4
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now