X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
   Reply to this topicStart new topic
> Find All Tables That Are Not Part Of Any Relationship, Any Version    
post Jun 30 2015, 11:23 AM

Posts: 670
Joined: 31-July 11

This code finds all tables in your Access application that are not part of any application. In order to run it, just execute Call RunmFindTablesNotPartOfRelationship
Place the following code in a module.

Caution: This code creates and deletes 3 tables:

Please ensure that your application does not use these tables. If it does, then you will want to modify the code below appropriately. As always, you should also ensure that you have a good back-up of your application before you run any new code in your application.

Option Compare Database
Option Explicit

'*  This module finds tables that are not part of any
'*  relationship. It fills a table called tblResults
'*  with the list of tables that do not have any
'*  relationships.
'*  David Warwick
'*  2015/6/30

Public Sub RunmFindTablesNotPartOfRelationship()
End Sub

Private Sub BuildtmpTables()
If ifTableExists("tblAllTables") Then DoCmd.RunSQL "Drop TABLE tblAllTables;"
If ifTableExists("tblTablesWithRelationships") Then DoCmd.RunSQL "Drop TABLE tblTablesWithRelationships;"

DoCmd.RunSQL "Create TABLE tblAllTables (TableName Text)"
DoCmd.RunSQL "Create TABLE tblTablesWithRelationships (TableName Text)"
End Sub

Private Sub FindTablesWithRelationships()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim rel As DAO.Relation
Set db = CurrentDb

For Each rel In db.Relations
    If Left(rel.Table, 4) <> "MSys" Then
        If DCount("[TableName]", "tblTablesWithRelationships", "[TableName]='" & rel.Table & "'") = 0 Then
            DoCmd.SetWarnings False
                DoCmd.RunSQL "INSERT INTO tblTablesWithRelationships(TableName) SELECT '" & rel.Table & "' AS Expr1;"
            DoCmd.SetWarnings True
        End If
        If DCount("[TableName]", "tblTablesWithRelationships", "[TableName]='" & rel.ForeignTable & "'") = 0 Then
            DoCmd.SetWarnings False
                DoCmd.RunSQL "INSERT INTO tblTablesWithRelationships(TableName) SELECT '" & rel.ForeignTable & "' AS Expr1;"
            DoCmd.SetWarnings True
        End If
    End If
Next rel
Set db = Nothing
End Sub

Private Sub FindAllTables()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Set db = CurrentDb

For Each tdf In db.TableDefs
    If Left(tdf.Name, 4) <> "MSys" _
    And Left(tdf.Name, 1) <> "~" _
    And Left(tdf.Name, 4) <> "USys" _
    And tdf.Name <> "tblAllTables" _
    And tdf.Name <> "tblTablesWithRelationships" _
    And tdf.Name <> "tblResults" Then
        DoCmd.SetWarnings False
            DoCmd.RunSQL "INSERT INTO tblAllTables(TableName) SELECT '" & tdf.Name & "' AS Expr1;"
        DoCmd.SetWarnings True
    End If
Next tdf
End Sub

Private Sub GetResults()
'Check of tblResults is open. If it is, close it.
If SysCmd(acSysCmdGetObjectState, acTable, "tblResults") <> 0 Then DoCmd.Close acTable, "tblResults"

DoCmd.SetWarnings False
    DoCmd.RunSQL "SELECT tblAllTables.TableName " & _
    "INTO tblResults " & _
    "FROM tblAllTables LEFT JOIN tblTablesWithRelationships ON tblAllTables.[TableName] = tblTablesWithRelationships.[TableName] " & _
    "WHERE (((tblTablesWithRelationships.TableName) Is Null));"
DoCmd.SetWarnings True

DoCmd.OpenTable "tblResults"
End Sub

Private Function ifTableExists(tblName As String) As Boolean
If DCount("[Name]", "MSysObjects", "[Name] = '" & tblName & "'") > 0 Then
ifTableExists = True
End If
End Function
Go to the top of the page

Custom Search
RSSSearch   Top   Lo-Fi    19th October 2018 - 04:46 PM