Detect whether RecordSource data comes from a query

[Alc]

I've managed to get a function working that allows the user to create a PowerPoint slide from a given report. Where I'm hitting a roadblock is when I establish the RecordSource. Some of the reports get their data from a named query, some from a fully described SQL statement.

In the latter cases, the following works.

str_RecordSource = Reports(CurrentOpenReport).RecordSource

When I know, I'm dealing with a query, the following will give me what I need (having run the previous code first).

Dim QDF As QueryDef

Set QDF = CurrentDb.QueryDefs(str_RecordSource)
str_Actual_RecordSource = QDF.SQL

What I now want is some method of detecting if the RecordSource property is the name of query or not. I'm assuming I could cycle through all query names in the Database and look for a match, but my VBA isn't up to that, at present .

Any suggestions gratefully received.

 

[mhartman]

Hello

You can use the MsysObjects table and get it from there. the digit 5 is the constant for queries.

SELECT MsysObjects.Name
FROM MsysObjects
WHERE (((MsysObjects.Type) In (5)));

Regards
Mark

 

[Alc]

Mark, thanks a lot for the response.

I'm running the following, but without success (i.e. no matches even where I know there should be one). The MsBox at point 1 shows the correct value.

Anything jump off the screen at you?

    str_DataSet = Reports(CurrentOpenReport).RecordSource
    Msgbox str_DataSet

    Set db = CurrentDb()
    str_QueryList = "SELECT MsysObjects.Name FROM MsysObjects WHERE (((MsysObjects.Type) In (5)));"
    Set rst = db.OpenRecordset(str_QueryList, dbOpenSnapshot)
    With rst
        .MoveFirst
        Do Until .EOF
            If UCase(str_DataSet) = UCase(rst.NAME) Then
                Set QDF = CurrentDb.QueryDefs(str_DataSet)
                str_DataSet = QDF.SQL
                Exit Do
            End If
        .MoveNext
        Loop
    End With

 

[mhartman]

Hello:

I'm not sure what version your using, but the below works for XP and 2003 and maybe 2000

Regards
Mark

Sub AllQueries()
Dim obj As AccessObject, dbs As Object
Set dbs = Application.CurrentData
' Search for open AccessObject objects in AllQueries collection.
For Each obj In dbs.AllQueries
If obj.IsLoaded = True Then
' Print name of obj.
Debug.Print obj.Name
End If
Next obj
End Sub

 

[RoyVidar]

? rst.NAME will give you "the name" of the recordset, aka the source (here the select statement).

Compare with a field name in stead.

If UCase(str_DataSet) = UCase(rst.fields("NAME")) Then

Better, apply the condition in the where clause, then check for existing records ... WHERE MsysObjects.Type = '" & str_DataSet & "'"

Or use a brute force approach (air code)

Dim QDF As QueryDef

on error resume next
Set QDF = CurrentDb.QueryDefs(str_RecordSource)
if err.number <> 0 then
'ouch, isn't a query
err.clear
else
str_Actual_RecordSource = QDF.SQL
endif

 

[Alc]

Thanks both, very much appreciated.
I knew I had to be screwing up somewhere simple, but couldn't see where.

 

[Alc]

Spoke too soon

This is the complete sub procedure.

Private Sub btn_Choose_Click()
    Dim li_Case As Integer
    
    Dim rs As Recordset
    
    Dim str_Background_Image As String
    Dim str_Blank_Presentation As String
    Dim str_New_Name As String
    Dim str_New_File As String
    Dim str_Title As String
    Dim str_QueryList As String
    Dim str_Actual_RecordSource As String
    
    Dim db As Database
    
    Dim QDF As QueryDef
    
    Dim obj As AccessObject
    
    Dim dbs As Object
    
    'Check the selected format
    '----------------------------
    If Me!Option6 = True Then   '-- Heading and Chart
        li_Case = 6
    ElseIf Me!Option9 = True Then   '-- Heading and Table
        li_Case = 9
    ElseIf Me!Option10 = True Then  '-- Heading, Table and Chart
        li_Case = 10
    Else
        MsgBox "No format selected"
        Exit Sub
    End If
    
    DoCmd.Close
    
    'Set the values needed
    '-----------------------
    Set db = CurrentDb()
    str_DataSet = Reports(CurrentOpenReport).RecordSource
    
    'Check if the report obtains its data from a named query,
    'as opposed to a specifically stated SQL statement
    '---------------------------------------------------------
    Set dbs = Application.CurrentData
    For Each obj In dbs.AllQueries
        If UCase(obj.NAME) = UCase(str_DataSet) Then
             Set QDF = CurrentDb.QueryDefs(str_DataSet)
             str_DataSet = QDF.SQL
        End If
    Next obj

    [B]Set rs = db.OpenRecordset(str_DataSet, dbOpenDynaset)[/B]
    str_Background_Image = DLookup("DBFolder", "DBID", "Reason = 'Powerpoint'") & "Blank Powerpoint Background.jpg"
    str_Blank_Presentation = DLookup("DBFolder", "DBID", "Reason = 'Powerpoint'") & DLookup("DBName", "DBID", "Reason = 'Powerpoint'")
    str_New_Name = "Slide_Created_" & Format(Now, "HH-MM DDDD-MMM,YYYY") & ".ppt"
    str_New_File = DLookup("DBFolder", "DBID", "Reason = 'Powerpoint'")
    str_Title = [Reports](CurrentOpenReport)![lbl_Title]
    
    Call Create_Ppt(li_Case, db, rs, str_Background_Image, str_Blank_Presentation, str_New_Name, str_New_File, str_Title)
End Sub

When the line in bold is reached, I get an error message

RunTime Error '3061'
Too few parameters. Expected 1.

I've tested that str_DataSet is being set and I've tested that the SQL statement within str_DataSet runs if pasted directly into a query (so the syntax is correct).
Why does the error message tell me that a parameter is missing?
The variable str_DataSet is pretty long, can that have an effect?

 

[RoyVidar]

Well, the most obvious question is, does the queries have parameters?

If the answer is yes, then they need to be resolved. While the DoCmd.Thingies and perhaps some other methods are able to fetch stuff from open forms etc, the OpenRecordset method isn't. Here's some air code supposed to resolve form references

dim prm as DAO.parameter


if qdf is nothing then
    Set rs = db.OpenRecordset(str_DataSet, dbOpenDynaset)
else
    for each prm in qdf.parameters
        prm.value = eval(prm.name)
    next prm
    set rs = qdf.openrecordset()
end if

btw - also use your db variable when you retrieve the querydef

Set QDF = db.QueryDefs(str_DataSet)

repeated calls to CurrentDB....

 

[Darrenc]

I could be way off the mark here, but i've been caught out with the 'Too few parameters problem'.

Try setting these too:

Dim db        As DAO.Database
Dim rs         As DAO.Recordset
Dim QDF      As DAO.QueryDef

 

[Alc]

Many, many thanks to all who offered advice.

In case anyone else finds it useful, the following worked perfectly.

Oh, and in repsonse to the earlier question posed, I'm running Access 2003 in an XP enviornment.

    Dim li_Case As Integer
    
    Dim rs As Recordset
    
    Dim str_Background_Image As String
    Dim str_Blank_Presentation As String
    Dim str_New_Name As String
    Dim str_New_File As String
    Dim str_Title As String
    Dim str_QueryList As String
    Dim str_Actual_RecordSource As String
    
    Dim db As Database
    
    Dim QDF As QueryDef
    
    Dim obj As AccessObject
    
    Dim dbs As Object
    
    'Check the selected format
    '----------------------------
    If Me!Option6 = True Then   '-- Heading and Chart
        li_Case = 6
    ElseIf Me!Option9 = True Then   '-- Heading and Table
        li_Case = 9
    Else
        MsgBox "No format selected"
        Exit Sub
    End If
    
    DoCmd.Close
    
    'Set the values needed
    '-----------------------
    Set db = CurrentDb()
    str_DataSet = Reports(CurrentOpenReport).RecordSource
    
    'Check if the report obtains its data from a named query,
    'as opposed to a specifically stated SQL statement
    '---------------------------------------------------------
    Set dbs = Application.CurrentData
    For Each obj In dbs.AllQueries
        If UCase(obj.NAME) = UCase(str_DataSet) Then
            Set QDF = db.QueryDefs(str_DataSet)
            If QDF Is Nothing Then
                Set rs = db.OpenRecordset(str_DataSet, dbOpenDynaset)
                GoTo RecordSet_Established
            Else
                For Each prm In QDF.Parameters
                prm.Value = Eval(prm.NAME)
                Next prm
                Set rs = QDF.OpenRecordset()
                GoTo RecordSet_Established
            End If
        End If
    Next obj

    Set rs = db.OpenRecordset(str_DataSet, dbOpenDynaset)
RecordSet_Established:
    str_Background_Image = DLookup("DBFolder", "DBID", "Reason = 'Powerpoint'") & "Blank Powerpoint Background.jpg"
    str_Blank_Presentation = DLookup("DBFolder", "DBID", "Reason = 'Powerpoint'") & DLookup("DBName", "DBID", "Reason = 'Powerpoint'")
    str_New_Name = "Slide_Created_" & Format(Now, "HH-MM DDDD-MMM,YYYY") & ".ppt"
    str_New_File = DLookup("DBFolder", "DBID", "Reason = 'Powerpoint'")
    str_Title = [Reports](CurrentOpenReport)![lbl_Title]
    
    'Call function to create PowerPoint slide
    '-----------------------------------------
    Call Create_Ppt(li_Case, db, rs, str_Background_Image, str_Blank_Presentation, str_New_Name, str_New_File, str_Title)