Solved

Access VBA (2003 & 2007) - List all objects and nested objects used in the creation of a query.

Posted on 2015-01-29
9
461 Views
Last Modified: 2016-02-10
Hello All,

Many times during the course of my job, I need to find out the origin of the data that comes from a query.  Most of the times these queries are several levels deep.  What I want is to pass a query name to a procedure and have that procedure list all the queries and tables that make up the specified query.

For example:
Lets say I have a Make table query called: [qryTest_Make]
That query gets it's data from a query called: [qryTest_Select]
Which is made up of 2 queries and a table called: [qryT1_Select], [qryT2_Select] and [tblSampleData]
Query [qryT1_Select] get's it data from [tblT1Data]
Query [qryT2_Select] get's it data from [tblT2Data]

The results of the procedure would look something like this:

qryTest_Make
- qryTest_Select
-- qryT1_Select
--- tblT1Data
-- qryT2_Select
--- tblT2Data
-- tblSampleData

Anyone have any idea how to do this?
Thanks
0
Comment
Question by:shannonds
  • 6
  • 3
9 Comments
 
LVL 34

Expert Comment

by:PatHartman
ID: 40578119
You can do it by using the fields collection of the querydef collection.
You will need to write a recursive loop that keeps reading each level of the nested queries.  I don't have code that does this and it is not trivial so I can't just throw it together for   you.  Just remember that each query could contain more than one source query which has to be followed so you will have a lot of threads to follow.  Just do it top to bottom, left to right.  Follow each query to the bottom and then move back up one level and follow the next query down.

Take a look a the Total Access Analyzer product from FMS at www.fmsinc.com  It has a report that will show what you need.  I find this tool to be invaluable for analyzing "new" applications that I have to take on and modify.  I also use it to document apps that I write.

It is an excellent documentation tool.  My only problem with the FMS products is that they are version specific and new versions are not available in a timely manner.  There are still products without an A2013 version and A2016 will be released later this year.

Also, newer versions of Access provide some documentation but you would need to drill manually.
0
 

Author Comment

by:shannonds
ID: 40578484
How would you go about using the fields collection of the querydef collection to get the sources (ie.. Queries and/or Tables)?
0
 
LVL 34

Expert Comment

by:PatHartman
ID: 40579100
This is code from my documentation tool.  It reads the querydefs collection and writes the info to a table.  It does not attempt to create a hierarchy.

You could use this code but you would need to create the necessary table and fix up the form field references.
Sub Create_tblQueryFields()

    Dim db As DAO.Database
    Dim qryLoop As DAO.QueryDef
    Dim fldLoop As DAO.Field
    Dim TD1 As DAO.TableDef
    Dim QD1 As DAO.QueryDef
    Dim TempSet1 As DAO.Recordset
    Dim strDatabase As String
    Dim ThisDB As DAO.Database
    Dim CountQueries As Integer
    
    On Error GoTo Err_Create_tblQueryFields
    strDatabase = Forms!frmPrintDoc!txtDBName
    
    CountQueries = 0
    Set ThisDB = CurrentDb()
    If strDatabase = "" Then
        Set db = CurrentDb()
    Else
        Set db = DBEngine.Workspaces(0).OpenDatabase(strDatabase)
    End If
    
    db.Containers.Refresh
    
    Set QD1 = ThisDB.QueryDefs!QdeltblQueryFields
        QD1.Execute
    Set TD1 = ThisDB.TableDefs!tblQueryFields
    Set TempSet1 = TD1.OpenRecordset

    ' Enumerate QueryDefs collection.
    For Each qryLoop In db.QueryDefs
        ' Enumerate Fields collection of each
        ' QueryDef object.
        
        CountQueries = CountQueries + 1
        Forms!frmPrintDoc!TxtQueryCount = CountQueries
        Forms!frmPrintDoc!txtQueryName = qryLoop.Name
        Forms!frmPrintDoc.Repaint
        Debug.Print qryLoop.Name
        Debug.Print qryLoop.SQL
        For Each fldLoop In qryLoop.Fields
        
            If Left(qryLoop.Name, 1) = "z" Or Left(qryLoop.Name, 1) = "~" Or Left(qryLoop.Name, 2) = "xx" Then
            Else
                TempSet1.AddNew
                TempSet1!QueryName = qryLoop.Name
                
                'Debug.Print qryLoop.Name & "-" & fldLoop.GetChunk
                
                TempSet1!FieldName = fldLoop.Name
                TempSet1!SourceField = fldLoop.SourceField
                TempSet1!SourceTable = fldLoop.SourceTable
                TempSet1!OrdinalPosition = fldLoop.OrdinalPosition
                TempSet1!RecordsetType = qryLoop.Type
                TempSet1!SQL = qryLoop.SQL
                TempSet1!AllowZeroLength = fldLoop.AllowZeroLength
                TempSet1!DefaultValue = fldLoop.DefaultValue
                'TempSet1!FieldSize = fldLoop.FieldSize
                TempSet1!Required = fldLoop.Required
                TempSet1!Type = fldLoop.Type
                TempSet1!ValidationRule = fldLoop.ValidationRule
                TempSet1.Update
                
            End If
        Next fldLoop
    Next qryLoop

Exit_Create_tblQueryFields:
    db.Close
    Exit Sub

Err_Create_tblQueryFields:
    Select Case Err.Number
        Case 3043
            MsgBox "Please select a valid database", vbOKOnly
        Case 91   ' db was not opened so it cannot be closed.
            Exit Sub
        Case Else
            MsgBox Err.Number & "-" & Err.Description
    End Select
    Resume Exit_Create_tblQueryFields
End Sub

Open in new window

0
 

Author Comment

by:shannonds
ID: 40579426
This looks good but doesn't seem to work on Action queries.  I'm I correct on this?  Typically an action query is where my research tends to start.  I'll have a macro that has a number of queries being run.  I'll need to find the action query and then determine where everything is coming from.  

Another reason for this is if I'm trying to strip-down a database to make a new one that only contains the necessary objects required for a specified macro to run.
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 34

Expert Comment

by:PatHartman
ID: 40581729
Have you looked at the Total Access Analyzer yet?
0
 

Author Comment

by:shannonds
ID: 40586158
TAA - I have it and unfortunately it won't do what I'm looking for, mainly because of the multiple versions of Access we have.  I am halfway through the solution.  In fact the hard part is now done.  I'll post the completed code when I'm done.  Thanks for sharing your ideas.  Unfortunately they won't work for what I want to accomplish.

Thanks,
Anyway...
0
 

Accepted Solution

by:
shannonds earned 0 total points
ID: 40593444
Here's the finished code.  I'm using it to create the source table for a treeview control.  It works like a charm...


'***************************************************************    Code for Query Research     ***************************************************************

Sub BuildQryResearchTreeSource(strQryName As String)
    If TableExists("tblQryResearchTreeSource") = False Then 'if table exists empty it, otherwise create it.
        CurrentDb.Execute "CREATE TABLE tblQryResearchTreeSource " & _
              "(" & _
              "UID COUNTER CONSTRAINT PrimaryKey PRIMARY KEY ," & _
              "Parent Text(255)," & _
              "Child Text(255)," & _
              "ChildDesc Text(255)" & _
              ");"
    Else
        DoCmd.SetWarnings False
        DoCmd.RunSQL "DELETE * FROM tblQryResearchTreeSource;"
        DoCmd.SetWarnings True
    End If

    DoCmd.SetWarnings False
    DoCmd.RunSQL "INSERT INTO tblQryResearchTreeSource ( Parent, Child, ChildDesc ) SELECT Null AS Parent, '" & strQryName & "' AS Child, 'qry' AS ChildDesc;"
    DoCmd.SetWarnings True

    ListFrom strQryName
   
End Sub

Sub ListFrom(strQryName As String)  'list the sources of the specified query
Dim rst As DAO.Recordset, strSQL As String
Dim qdf As DAO.QueryDef, strSQL2Chk As String
       
    strSQL = "SELECT IIf([Type] In (1,4,6),'tbl','qry') AS ObjType, MSysObjects.Name " & _
                "FROM MSysObjects " & _
                "WHERE (((MSysObjects.Name) Not Like 'MSys*' And (MSysObjects.Name) Not Like '~*') " & _
                "AND ((MSysObjects.Flags)<>-2146828288) AND ((MSysObjects.Type) In (1,4,5,6))) " & _
                "ORDER BY IIf([Type] In (1,4,6),'tbl','qry') DESC , MSysObjects.Name;"

    Set rst = CurrentDb.OpenRecordset(strSQL)
        rst.MoveLast
        rst.MoveFirst
       
    Set qdf = CurrentDb.QueryDefs(strQryName)
    strSQL2Chk = Mid(qdf.SQL, InStr(qdf.SQL, "FROM ") + 5)  'only need to check the FROM clause on...
       
        Do While Not rst.EOF
            If CheckObject(strSQL2Chk, rst!name) = True Then
'                Debug.Print strQryName & ", " & rst!name
               
                DoCmd.SetWarnings False
                DoCmd.RunSQL "INSERT INTO tblQryResearchTreeSource ( Parent, Child, ChildDesc ) SELECT '" & strQryName & "' AS Parent, '" & rst!name & "' AS Child, '" & rst!objType & "' AS ChildDesc;"
                DoCmd.SetWarnings True
               
                If DCount("*", "MSysObjects", "[Name] = '" & rst!name & "' and [Type] In (1,4,6)") = 0 Then 'If the current value is a query.
                    ListFrom rst!name   'run the recursive procedure
                End If
            End If
           
            rst.MoveNext
        Loop
       
Set rst = Nothing
Set qdf = Nothing

End Sub

Function CheckObject(ByVal parmSQL As String, ByVal parmTQname As String) As Boolean    'check if the specified object is part of the FROM clause in the specified query
Static oRE As Object

    If oRE Is Nothing Then
        Set oRE = CreateObject("vbscript.regexp")
        oRE.Global = True
        oRE.ignorecase = True
    End If
   
    oRE.Pattern = "\b" & parmTQname & "\b"
    CheckObject = oRE.test(parmSQL)
End Function

Public Function TableExists(ByVal name As String) As Boolean
    On Error Resume Next
    TableExists = LenB(CurrentDb.TableDefs(name).name)
End Function
0
 

Author Closing Comment

by:shannonds
ID: 40602739
After a tremendous amount of research and studying up on recursive procedures, this is the code I finally came up with.  It works very well.
0
 

Author Comment

by:shannonds
ID: 40613882
Turns out there was an issue with my prior code.  Any object that had a similar name would cause an issue, so I rewrote it as follows:

Sub BuildQryResearchTreeSource(strQryName As String)
    If TableExists("tblQryResearchTreeSource") = False Then 'if table exists empty it, otherwise create it.
        CurrentDb.Execute "CREATE TABLE tblQryResearchTreeSource " & _
              "(" & _
              "UID COUNTER CONSTRAINT PrimaryKey PRIMARY KEY ," & _
              "Parent Text(255)," & _
              "Child Text(255)," & _
              "ChildDesc Text(255)" & _
              ");"
    Else
        DoCmd.SetWarnings False
        DoCmd.RunSQL "DELETE * FROM tblQryResearchTreeSource;"
        DoCmd.SetWarnings True
    End If

    DoCmd.SetWarnings False
    DoCmd.RunSQL "INSERT INTO tblQryResearchTreeSource ( Parent, Child, ChildDesc ) SELECT Null AS Parent, '" & strQryName & "' AS Child, 'qry' AS ChildDesc;"
    DoCmd.SetWarnings True

    strQryName = ShowDependencies1(strQryName)
   
End Sub

Function ShowDependencies1(strName As String) As String
' Show dependency information for the specified object
Dim AO As AccessObject, AO2 As AccessObject, DI As DependencyInfo
Dim t As AccessObject, d As DependencyInfo, strType As String
On Error GoTo HandleErr

    ' Get the AccessObject
    Select Case DLookup("type", "MSysObjects", "[Name] = '" & strName & "'")
   
    Case 1, 4, 6
        Set AO = CurrentData.AllTables(strName)
   
    Case Else
        Set AO = CurrentData.AllQueries(strName)
   
    End Select

    ' Get the dependency info
    Set DI = AO.GetDependencyInfo()
   
    If DI.Dependencies.Count = 0 Then
        ShowDependencies1 = ""
    Else
       
        For Each AO2 In DI.Dependencies
       
            Select Case DLookup("type", "MSysObjects", "[Name] = '" & AO2.Name & "'")
           
            Case 1, 4, 6
                strType = "tbl"
           
            Case Else
                strType = "qry"
           
            End Select
           
            DoCmd.SetWarnings False
            DoCmd.RunSQL "INSERT INTO tblQryResearchTreeSource ( Parent, Child, ChildDesc ) SELECT '" & strName & "' AS Parent, '" & AO2.Name & "' AS Child, '" & strType & "' AS ChildDesc;"
            DoCmd.SetWarnings True
           
            If strType = "qry" Then
                strQryName = ShowDependencies1(AO2.Name)  'run the recursive procedure
            End If
           
            ShowDependencies1 = AO2.Name
       
        Next AO2
   
    End If
                                           
ExitHere:
Exit Function

HandleErr:  MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
Resume ExitHere

End Function
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Displaying an arrayList in a listView using the default adapter is rarely the best solution. To get full control of your display data, and to be able to refresh it after editing, requires the use of a custom adapter.
Technology opened people to different means of presenting information, but PowerPoint remains to be above competition. Know why PPT still works today.
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…
In Microsoft Access, when working with VBA, learn some techniques for writing readable and easily maintained code.

746 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

12 Experts available now in Live!

Get 1:1 Help Now