Getting Around VBA Not Resolving Query Refs To Forms?

[PeteCresswell]

When users open an MS Access report via a "Reports" screen, I'm
offering up an "Excel" option where Report_Open invokes
TransferSpreadsheet against it's .RecordSource instead of creating an
MS Access report.

Works like a champ - as long as .RecordSource is a query or table
name.

Dies a horrible death if .RecordSource is some SQL concocted on-the-
fly by Report_Open.

All as expected per Dirk Goldgar's observation that
TransferSpreadsheet only works with table/query names.


In trying to craft a workaround, I wrote a routine that creates a
spreadsheet and boogies through a .Recordset, writing columns/rows.

Before creating said recordset, I do something like

1220 With fHome
1221 mySQL = Replace(mySQL, "[forms]![frmHome]![txtAsOfDate]",
"#" & !txtAsOfDate & "#")
1229 End With

to get rid of the form references.

But that doesn't deal with recordsets where query A invokes query B
and query B has ref's a form field.

So, bottom line, I'm wondering if there's some magic that will let VBA
resolve those troublesome Form.Field references. IMHO the inability
to do so seems to border on being a bug....

Or do I need to revisit my practice of embedding Form.Field references
in queries? Right now, although I don't have an alternative on the
tip of my tongue for all cases, it seems like it might be one of those
"Bad Practice" things.

 

[Dirk Goldgar]

When users open an MS Access report via a "Reports" screen, I'm
offering up an "Excel" option where Report_Open invokes
TransferSpreadsheet against it's .RecordSource instead of creating an
MS Access report.

Works like a champ - as long as .RecordSource is a query or table
name.

Dies a horrible death if .RecordSource is some SQL concocted on-the-
fly by Report_Open.

All as expected per Dirk Goldgar's observation that
TransferSpreadsheet only works with table/query names.


In trying to craft a workaround, I wrote a routine that creates a
spreadsheet and boogies through a .Recordset, writing columns/rows.

Before creating said recordset, I do something like

1220 With fHome
1221 mySQL = Replace(mySQL, "[forms]![frmHome]![txtAsOfDate]",
"#" & !txtAsOfDate & "#")
1229 End With

to get rid of the form references.

But that doesn't deal with recordsets where query A invokes query B
and query B has ref's a form field.

So, bottom line, I'm wondering if there's some magic that will let VBA
resolve those troublesome Form.Field references.

Yes. You can use a temporary QueryDef object, and walk its Parameters
collection. Here's an example:

'------ start of example code ------

Dim strSQL As String

Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Dim rs As DAO.Recordset

strSQL = _
"SELECT * FROM Table1 WHERE " & _
"TransDate >= [Forms]![frmHome]![txtAsOfDate]"


Set db = CurrentDb
Set qdf = db.CreateQueryDef("", strSQL)
With qdf
For Each prm In .Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rs = .OpenRecordset
End With

'------ end of example code ------

You *may* need to add a PARAMETERS statement to the SQL string in this case,
to identify the data type of the parameter. I'm not sure.

 

[Tony Toews [MVP]]

In trying to craft a workaround, I wrote a routine that creates a
spreadsheet and boogies through a .Recordset, writing columns/rows.

That'll be very slow. Doing the CopyFromRecordset is far, far faster
and does work with the following bit of code.

So, bottom line, I'm wondering if there's some magic that will let VBA
resolve those troublesome Form.Field references. IMHO the inability
to do so seems to border on being a bug....

' The following code stuffs the value of the form field into the
query parameter. This avoids the
' dreaded runtime error 3061, "Too few parameters. Expected 1." on
the OpenRecordSet line
strSQL = "SELECT * FROM [" & strQuery & "]"
If Len(strWhere) > 0 Then _
strSQL = strSQL & " WHERE " & strWhere & ";"
Set qdf = db.CreateQueryDef("", strSQL)
' Set qdf = db.QueryDefs(strQuery)
For i = 0 To qdf.Parameters.Count - 1
qdf.Parameters(i) = Eval(qdf.Parameters(i).Name)
Next i

Set rs = qdf.OpenRecordset(dbOpenSnapshot)
......
' Insert recordset into cells starting at left hand side and
second row
' Using a copyfromRecordset is much, much faster than
stuffing in the cells one at a time.
.range("A2").CopyFromRecordset rs

My standard routine for stuffing queries into Excel spreadsheets is
now about 400 lines long. Among other things it
- removes columns that are autonumber fields
- removes columns with specific names, which are generally long
integer foreign keys which are used in the where clause,
- insert the report/query name in cell A1
- insert the human readable where clause in cell A2 (although not in
this example)
- overrides column headings as captions from the field caption
- autofit the cells
.range(.Cells(CurrentHeadingRow + 1, 1), .Cells(rsRecordCount
+ CurrentHeadingRow + 1, _
iCountOfCols)).Columns.AutoFit
- Change the cell formatting to put the text at the top of the cell
rather than the bottom.
' otherwise it's visually disconcerting when viewing text
or memo fields with multiple lines
.range(.Cells(1, 1), .Cells(rsRecordCount,
iCountOfCols)).Cells.VerticalAlignment = -4160 ' xlVAlignTop

Tony

 

[David W. Fenton]

m:

In trying to craft a workaround, I wrote a routine that creates a
spreadsheet and boogies through a .Recordset, writing
columns/rows.

Before creating said recordset, I do something like

1220 With fHome
1221 mySQL = Replace(mySQL,
"[forms]![frmHome]![txtAsOfDate]", "#" & !txtAsOfDate & "#")
1229 End With

to get rid of the form references.

But that doesn't deal with recordsets where query A invokes query
B and query B has ref's a form field.

Have you tried defining your form references as parameters? That
would be:

PARAMETERS [Forms]![frmHome]![txtAsOfDate] DateTime;

....at the top of your query/recordsource.

I'm not entirely certain if this will resolve via DAO, but it's
something you should be doing in any case, because without it, the
Access/Jet expression service resolves these references in an
unreliable fashion (it worked fine back in A97, but from A2000 on,
it's been unreliable).

 

[PeteCresswell]

Well, here's what I came up with.

One requirement was that the process did not bloat the application
when run over-and-over.

My first assumption was that creating a permanent dummy querydef and
re-populating it's SQL every time the routine was run would make the
DB grow.

My second (as yet untested....) assumption was that creating a
temporary querydef and then setting it = Nothing would not make the DB
grow.

To those ends I did the following:

' - Copy SQL to a temp QueryDef
' - Walk the temp QueryDef's parm list and replace
each
' parm with it's resolved value
' - Open up a RecordSet using the temp QueryDef
' - Make a link to a temp table in the work DB
' - Delete the temp table in the work DB, leaving the
link intact
' - Re-create the temp table in the work DB using
contents of our RecordSet
' - Invoke TransferSpreadsheet using the link name we
created


Source code is below.

Probably needs mucho work bc, for instance, I am not checking to see
if the tab name I come up with is legal within Excel.

But it *seems* to work in preliminary testing:
============================================
Public Function Excel_QuickDirtyExport_InputSQL( _
ByVal
theOpenSpreadsheetSwitch As Boolean, _
ByVal theSQL As
String, _
ByRef theReport As
Report _
) As String
19000 DebugStackPush mModuleName & ": Excel_QuickDirtyExport_InputSQL"
19001 On Error GoTo Excel_QuickDirtyExport_InputSQL_err

' PURPOSE: To provide a means for a Report_Open() event to send
the report's
' output to Excel instead of rendering it on the MS
Access report IN
' CASES WHERE THE .RECORDSOURCE IS RAW SQL INSTEAD OF A
TABLE OR QUERY
' as required by .TransferText
' ACCEPTS: - Switch telling us whether to open the created
spreadsheet or not
' - SQL of calling report's .RecordSet
' - Pointer to the calling report
' RETURNS: UNC to spreadsheet we created
'
' NOTES: 1) Overall strategy as follows:
' - Copy SQL to a temp QueryDef
' - Walk the temp QueryDef's parm list and replace
each
' parm with it's resolved value
' - Open up a RecordSet using the temp QueryDef
' - Make a link to a temp table in the work DB
' - Delete the temp table in the work DB, leaving the
link intact
' - Re-create the temp table in the work DB using
contents of our RecordSet
' - Invoke TransferSpreadsheet using the link name we
created
' 2) It is on the calling routine to control HourGlass
' 3) Because of all the MIPS we use creating the TableDef
and iterating through
' a recordset, this routine should only be used when
the report's .RecordSet
' is raw SQL. When .RecordSet is a query or table
name, you should use
' Excel_QuickDirtyExport_InputQueryOrTableName()

19002 Dim workDB As DAO.Database
Dim inputRS As DAO.Recordset
Dim outputRS As DAO.Recordset
Dim myQuery As DAO.QueryDef
Dim myTD As DAO.TableDef
Dim curParm As DAO.Parameter
Dim curField As DAO.Field

Dim mySS As Excel.Application
Dim myWS As Excel.Worksheet

Dim i As Long
Dim mySQL As String
Dim xlsPath As String
Dim tempPath As String
Dim curFieldName As String
Dim okToProceed As Boolean
Dim workDbPath As String
Dim fieldCount As Long

Const bufferTableName As String =
"ttblExcelQuickAndDirtyExport"

' ------------------------------------------------
' Get path to user's Temp() dir on Citrix server

19003 tempPath = windowsTempPath_Get()

19004 If IsNull(tempPath) Then
19005 BugAlert True, "Unable to retrieve path to Windows' 'Temp'
directory."
19006 Else
19007 okToProceed = True
19009 End If


' ---------------------------------------------------
' - Concoct a path for the spreadsheet we hope to create
' - Ensure that we have a work DB

19010 If okToProceed = True Then
19011 okToProceed = False
19012 tempPath = windowsTempPath_Get()
19013 xlsPath = tempPath & theReport.Caption & "." & CurrentUserGet
() & "." & Format$(Now(), "yyyy mm-dd hh-nn-ss") & ".xls"
19014 workDbPath = WorkDbPath_Get()
19015 okToProceed = WorkDbLocal_MakeSureWeHaveOne(workDbPath)
19019 End If


' ---------------------------------------------------
' - Create a temporary QueryDef and copy our SQL to it
' - Change each of it's parms from a reference to a value
' - Open up a .RecordSet using the query

19020 If okToProceed = True Then
19021 okToProceed = False
19029 Set myQuery = CurrentDb.CreateQueryDef("", theSQL)

19030 With myQuery
19031 For Each curParm In .Parameters
19032 curParm.Value = Eval(curParm.Name)
19039 Next curParm

19050 Set inputRS = .OpenRecordset(dbOpenSnapshot,
dbForwardOnly)
19051 okToProceed = True
19059 End With
19099 End If


' ---------------------------------------------------
' Make a link to our buffer table in the application's
' "work" db so TransferSpreadsheet can get to it

19110 If okToProceed = True Then
19111 okToProceed = False
19112 WorkTable_Create bufferTableName, "zmtblDummy"
19113 okToProceed = True
19119 End If


' ---------------------------------------------------
' Delete buffer table (which was just a dummy in order
' to make the link) from work DB and then replace it
' with our "real" buffer table.

19120 If okToProceed = True Then
19121 okToProceed = False
19122 workDbPath = WorkDbPath_Get()
19129 Set workDB = DBEngine(0).OpenDatabase(workDbPath)

19130 With workDB
19131 .TableDefs.Delete bufferTableName
19132 Set myTD = .CreateTableDef("buffertablename")
19139 End With

19140 myTD.Name = bufferTableName

19150 With inputRS
19159 fieldCount = .Fields.Count - 1

19160 For i = 0 To fieldCount
19161 curFieldName = .Fields(i).Name
19162 Set curField = Nothing
19163 Set curField = New DAO.Field
19164 curField.Name = curFieldName
19165 curField.Type = .Fields(i).Type
19166 curField.Size = .Fields(i).Size
19067 myTD.Fields.Append curField
19169 Next i
19170 End With

19190 workDB.TableDefs.Append myTD
19191 okToProceed = True
19199 End If


' ---------------------------------------------------
' Populate buffer table from RS we created from SQL

19210 If okToProceed = True Then
19219 okToProceed = False

19220 Set outputRS = CurrentDb.OpenRecordset(bufferTableName,
dbOpenDynaset, dbAppendOnly)

19230 With inputRS
19231 Do Until .EOF = True
19232 outputRS.AddNew

19233 For i = 0 To fieldCount
19234 outputRS.Fields(i).Value = .Fields(i).Value
19235 Next i

19236 outputRS.Update
19237 .MoveNext
19238 Loop
19239 End With

19290 okToProceed = True
19299 End If


' ---------------------------------------------------
' Create our spreadsheet by feeding name of buffer table
' to TransferSpreadsheet

19310 If okToProceed = True Then
19311 okToProceed = False
19312 DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel7,
bufferTableName, xlsPath
19313 okToProceed = True
19319 End If


' ------------------------------------------------
' - Remove any default sheets that the user's Excel
' defaults may have created

19410 If okToProceed = True Then
19419 okToProceed = False

19420 If SpreadSheetOpen_Existing(xlsPath, mySS) = True Then
19421 okToProceed = defaultSheets_Remove(mySS)
19429 End If
19499 End If


' ------------------------------------------------
' Name only remaining tab per calling report's .Caption
' and save the .XLS

19510 If okToProceed = True Then
19519 okToProceed = False

19520 With mySS.Workbooks(1)
19521 .Worksheets(1).Name = theReport.Caption
19522 .save
19529 End With

19530 okToProceed = True
19539 End If


' ------------------------------------------------
' - If user requested, open the spreadsheet we just created
' - Clear flag that causes reports tb rendered
' in Excel (so subsequent "Print" or "Preview"
' clicks on the same report will not force Excel)
' - Return path to SS

20990 If okToProceed = True Then
20991 If theOpenSpreadsheetSwitch = True Then
20992 FollowHyperlink xlsPath
20993 End If

20994 gSendReportToExcel = False
20995 Excel_QuickDirtyExport_InputSQL = xlsPath
20999 End If



Excel_QuickDirtyExport_InputSQL_xit:
DebugStackPop
On Error Resume Next
Set myWS = Nothing
Set mySS = Nothing
Set curParm = Nothing
Set curField = Nothing
myQuery.Close
Set myQuery = Nothing
inputRS.Close
Set inputRS = Nothing
outputRS.Close
Set outputRS = Nothing
Set myTD = Nothing
workDB.Close
Set workDB = Nothing
Exit Function

Excel_QuickDirtyExport_InputSQL_err:
BugAlert True, "Report='" & theReport.Name & "', curFieldName='" &
curFieldName & "'."
Resume Excel_QuickDirtyExport_InputSQL_xit
End Function
============================================

 

[PeteCresswell]

My second (as yet untested....) assumption was that creating a
temporary querydef and then setting it = Nothing would not make the DB
grow.

Looks to me like there is no growth.

To wit, the following test run 99,000 times seems to showno change in
the DB size.

I should probably insert a command to save the DB before getting the
"After" size - but can't figure out how to make it happen.

However I opened/ran the routine/closed the DB and manually checked
Before/After sizes a number of times with no apparent change.
============================================
Public Sub TempQueryDefBloatTest()
Dim myQuery As DAO.QueryDef

Dim i As Long
Dim sizeBefore As Long
Dim sizeAfter As Long

Const testSize As Long = 99000
Const mySQL As String = "SELECT tlkpRatingType.RatingTypeID,
tlkpRatingType.RatingTypeLong, tlkpRatingType.RatingTypeShort FROM
tlkpRatingType ORDER BY tlkpRatingType.RatingTypeLong;"

DoCmd.Hourglass True
SysCmd acSysCmdInitMeter, "Bloat Test: Performing " & Format$
(testSize, "#,##0") & " Iterations....", testSize

sizeBefore = FileLen(Application.CurrentDb.Name)

For i = 1 To testSize
Set myQuery = CurrentDb.CreateQueryDef("", mySQL)
Set myQuery = Nothing
SysCmd acSysCmdUpdateMeter, i
Next i

sizeAfter = FileLen(Application.CurrentDb.Name)

SysCmd acSysCmdRemoveMeter
DoCmd.Hourglass False

MsgBox "Before=" & Format$(sizeBefore, "#,###") & vbCrLf & _
" After=" & Format$(sizeAfter, "#,###") & vbCrLf & vbCrLf &
_
" Diff=" & Format$(sizeAfter - sizeBefore, "#,##0"),
vbInformation, "Bloat Test Done: " & Format$(testSize, "#,##0") & "
Iterations"
End Sub
============================================

 

[PeteCresswell]

To wit, the following test run 99,000 times seems to showno change in
the DB size.

Also, I ran the same routine except that it pushed SQL into the same
pemanent query over-and-over.

The DB did grow, albieit minimally. As a practical matter I would
expect new releases of the application way before any noticible bloat.

But still, as a matter of princple.....

But I also noticed that when we're pushing SQL into that permanent
query, it slowed down the routine hugely - so much, in fact, that I
never let it run to 99,9999 iterations.... stopped it after about
1,500, at which time it would have run the full 99,999 at least three
times with the temporary querydef.

 

[Clif McIrvin]

Pete, I really appreciate you sharing your findings. I tuck a lot of
this stuff away for possible future use!

Thanks.

--
Clif

To wit, the following test run 99,000 times seems to showno change in
the DB size.

Also, I ran the same routine except that it pushed SQL into the same
pemanent query over-and-over.

The DB did grow, albieit minimally. As a practical matter I would
expect new releases of the application way before any noticible bloat.

But still, as a matter of princple.....

But I also noticed that when we're pushing SQL into that permanent
query, it slowed down the routine hugely - so much, in fact, that I
never let it run to 99,9999 iterations.... stopped it after about
1,500, at which time it would have run the full 99,999 at least three
times with the temporary querydef.

 

[David W. Fenton]

m:

My first assumption was that creating a permanent dummy querydef
and re-populating it's SQL every time the routine was run would
make the DB grow.

I think this assumption is true.

My second (as yet untested....) assumption was that creating a
temporary querydef and then setting it = Nothing would not make
the DB grow.

I think this assumption is false, though the bloating is less than
with your first alternative.