Solved

Access VBA (2003 & 2007) - Parse out the "FROM" portion of a specified query's SQL statement...

Posted on 2015-01-30
13
491 Views
Last Modified: 2016-02-10
Hello All,
I want a procedure that when passed the name of a query is able to Parse out the "FROM" portion of the SQL and give me just a list of the names of the source Tables and/or Queries.  This needs to work on all query types.

If there's an easier way to get a list of the source objects without the need of Parsing out the "FROM" portion, I'm all ears.

Thanks
0
Comment
Question by:shannonds
  • 5
  • 3
  • 2
  • +2
13 Comments
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 40580196
dim sqlQ as string, strFrom

 sqlQ="select * from t1"

strFrom = mid(sqlQ, Instr(sqlQ,"From") + 5)

debug.print strFrom
0
 

Author Comment

by:shannonds
ID: 40580305
Unfortunately, it's not that simple.  Take for instance a query that has joins, groupings, sortings, etc...  

FROM tbl1 RIGHT JOIN [qry1] ON (tbl1.Param=[qry1].Parameter) AND (tbl1.LastName=[qry1].LastName) AND (tbl1.FirstName=[qry1].FirstName)
GROUP BY [qry1].Division, [qry1].Reg, [qry1].Dist, [qry1].Terr, [qry1].FirstName, [qry1].LastName, [qry1].ExportPath, tbl1.Login, tbl1.password, tbl1.companyEmail, Now()
ORDER BY [qry1].Division;

What I would want the procedure to do, based on the above section of SQL, would be to return the following:
tbl1
qry1

Obviously if it was a Union query with multiple "FROM" statements, it would get even more complected.  I was actually hoping that there was some querydef collection property that I'm unaware of, that would list the all the source objects.  I'm not referring to the Field.SourceTable Property because it returns a value that indicates the name of the table that is the original source of the data for a Field object.  What I really want is a list of all the source objects in a specified query.
0
 
LVL 119

Assisted Solution

by:Rey Obrero
Rey Obrero earned 150 total points
ID: 40580533
you can do this

dim qd as dao.querydef, db as dao.database, td as dao.tabledef
set db=currentdb

'get all names of saved queries
for each qd in db.querydefs
    debug.print qd.name
   'or save into an array of queries
next

'get all tables
for each td in db.tabledef
     debug.print td.name
    'or save into an array of tables
next

loop thru the arrays and check for the array element value in the string


strFrom = mid(sqlQ, Instr(sqlQ,"From") + 5)

if instr(strFrom, qArr(i)) then
   'create a string List of queries
   'check if the name is already in the list
   if  instr(strQ, qArr(i))=0 then
       'add to list
        strQ=strQ & "," & qArr(i)
   end if
end if

do the same for the tables using the table array.
0
 

Author Comment

by:shannonds
ID: 40580616
That's actually not a bad idea...  I'll try it out and get back to you.  Might not be tonight as I'm probably getting out of here soon, but I will get back to you.

Thanks,
Dave
0
 

Author Comment

by:shannonds
ID: 40580659
Actually, come to think of it, I wouldn't need to populate anything, because all objects are already specified in the MSysObjects table.  The only problem I see is if the name of the object is very similar.  For example, lets say I have the following situation...

strSQL = "Select * FROM qryTest11;"

if I'm looping thru the MSysObjects table and checking if the Name of the object is in the strSQL string, it will give a false positive it there's a query named "qryTest" or "qryTest1" or any other version of a similar name.

I'm sure there's a way around this, but I'll need to think on it a bit.
Thanks
0
 
LVL 45

Expert Comment

by:aikimark
ID: 40580664
If you have used at least one field from each table in your Select clause, you might iterate the fields and get their sourcetable property.
Example:
set qd = dbengine(0)(0).QueryDefs("query3")
for each fld in qd.fields
   debug.print fld.sourcetable    '& "." & fld.name
next

Open in new window

0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 34

Expert Comment

by:PatHartman
ID: 40580816
This code uses the querydefs collection and pulls all columns as well as tables.  You can write a query on the resulting table to get just a summary of the tables in a query.
to use the code, create the tblQueryFields.  Also create QdeltblQueryFields if you always want to start with an empty table. You can get rid of the form references.  I just use them to report back on the documentation process.
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: 40580819
Thanks aikimark, but that won't work for what I'm trying to do.
The Field.SourceTable Property doesn't work for me because it returns a value that indicates the name of the table that is the original source of the data for a Field object.  What I really want is a list of all the source objects in a specified query.

Here's what I've got so far.  It does what I want, but it will give a false positive for an object with a similar name.  (See my last comment above)

Sub test1(strQryName As String)
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)
        Debug.Print strSQL2Chk
       
        Do While Not rst.EOF
            If InStr(strSQL2Chk, rst!Name) > 0 Then
                Debug.Print rst!Name
            End If
   
            rst.MoveNext
        Loop
       
Set rst = Nothing
Set qdf = Nothing

End Sub

If I can get it to search the sql for an exact match then I'll be golden, at least for this part of it.  What I mean is if the sql I'm searching is:

strSQL = "Select * FROM qryTest11;"

and there happens to be a query in the database named "qryTest", doing an the following will result in a false true:

 If InStr(strSQL, "qryTest") > 0 Then
       code for true
 End If
0
 
LVL 34

Expert Comment

by:PatHartman
ID: 40580835
If you use the code I posted, you can join the SourceTable back to the list of queries to determine which is a query and which is a table if that is what you are after.

Also,
You might want to look at Total Access Analyzer by FMS - www.fmsinc.com
It provides excellent documentation of all database objects.
0
 
LVL 45

Accepted Solution

by:
aikimark earned 350 total points
ID: 40580888
Use this function instead of Instr().  Pass it the SQL and the name of the table/query.
Function Q_28607202(ByVal parmSQL As String, ByVal parmTQname As String) As Boolean
    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"
    Q_28607202 = oRE.test(parmSQL)
End Function

Open in new window

0
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 40581553
Just to explode some heads, what do you expect to happen when there are subqueries in the SELECT, FROM, WHERE, and/or HAVING clauses?

:)
0
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 40581575
well, then I suggest you keep on parsing

dim sFrom as string, sWhere as string, sHaving as string

sFrom=mid(ssql,instr(ssql, "From") + 4)

if instr(sFrom,"Where") then
 sWhere=mid(sFrom, instr(sFrom,"where") + 5)
end if

if instr(sFrom,"having") then
 sHaving=mid(sFrom, instr(sFrom,"having") + 6)
end if
0
 

Author Closing Comment

by:shannonds
ID: 40586121
Thanks you all for your help.  Here's what I ended up doing.  I'm still tweaking it, so it might not be as clean as the finished code, but wanted to get back to you sooner than later.  Thanks again...

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 rst!Name
            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
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

This article explains all about SQL Server Piecemeal Restore with examples in step by step manner.
Read about achieving the basic levels of HRIS security in the workplace.
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
With Microsoft Access, learn how to start a database in different ways and produce different start-up actions allowing you to use a single database to perform multiple tasks. Specify a start-up form through options: Specify an Autoexec macro: Us…

708 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

11 Experts available now in Live!

Get 1:1 Help Now