Hi everybody!
Recently I was struggling with client/server issues in MS Access/PostgreSQL combination.
Although Access is intuitive and easy to use desktop database solution, many problems appear when someone is trying to use it as front-end for real server database systems such as PostgreSQL or MySQL.
One of these problems is regarding pass-through queries and parameters.
I wanted to have all the code on client, while executing it on the server in order to increase performance and speed. Therefore I created pass-through queriers for my forms and reports. The problem was that I couldn't pass parameters for where clause criteria, such as start and end-date. Therefore I have written procedure that passes parameters to pass-through queries.
I hope it will help to those dealing with the same problem...
For this method we use 2 saved pass-through queries.First, we have query with parameter name included in code in criteria expression. Then, we have another query which SQL string is generated from the first one. The SQL string is refreshed each time before query execution, so that parameter name is replaced with actual value. The form is based on that executive pass-through query...
'------------------------------------------------------------
' This code has a list of saved pass-through queries along with parameters.and can be called
' on Click event.
' Theprocedure calls function ParametersToQueries () that recreates SQL string of executive query.
' written by: Zlatko Matic
'------------------------------------------------------------
Sub QueriesAndParameters ()
Dim ws As DAO.Workspace Dim db As DAO.DATABASE Dim QueryName As String Dim NumberOfParameters As Integer
On Error GoTo ErrorHandler
DoCmd.Hourglass True
Set ws = DBEngine(0) Set db = CurrentDb
'List of queries and parameters...For example:
QueryName = "SomeQuery"
NumberOfParameters = 3
' Transfer name of the query and parameters to funtion ParametersToQuery
Call ParametersToQuery (QueryName, NumberOfParameters, _
"StartDate", Format([Forms]![MenuForm]![START_DATE], "yyyy-mm-dd"), _
"EndDate", Format([Forms]![MenuForm]![END_DATE], "yyyy-mm-dd"), _
"Option", [Forms]![MenuForm]![OPTION])
Exit:
DoCmd.Hourglass False Exit Sub
ErrorHandler:
Dim strErr As String
strErr = "VBA-Error Information" & vbNewLine
strErr = strErr & "Number: " & vbTab & vbTab & Err.Number & vbNewLine
strErr = strErr & "Description: " & vbTab & Err.Description & vbNewLine
strErr = strErr & "LastDLLError: " & vbTab & Err.LastDllError & vbNewLine
strErr = strErr & vbNewLine
MsgBox strErr, vbOKOnly + vbExclamation, "Error"
Resume Exit
End Sub
Here is the code for function ParametersToQuery:
'------------------------------------------------------------
' This function recreates SQL string of executive pass-through query
' written by: Zlatko Matic
'------------------------------------------------------------
Function ParametriziranjePstUpita(QueryName As String, NumberOfParameters As Integer, ParamArray Parameters () As Variant)
Dim ws As DAO.Workspace Dim db As DAO.DATABASE Dim qdf As DAO.QueryDef Dim strSQL As String Dim strConnect As String Dim PstQueryName As String Dim n As Integer Dim x As Integer Dim ParameterName As Variant Dim ParameterValue As Variant Dim Parameter As Variant
On Error GoTo ErrorHandler
DoCmd.Hourglass True
Set ws = DBEngine(0) Set db = CurrentDb
PstQueryName = QueryName & "_prm"
'Open thempass-through query to extract SQL string
Set qdf = db.QueryDefs(PstQueryName)
strSQL = qdf.SQL
strConnect = qdf.Connect
'Creation of new SQL string
'Assign parameters
If NumberOfParameters > 0 Then
x = 0
For n = 0 To ((NumberOfParameters * 2) - 1) Step 2
ParameterName = Parameters (n)
ParameterValue = Parameters (n + 1)
strSQL = Replace(strSQL, ParameterName, ParameterValue)
x = x + 1
Next n
End Ifqdf.Close
'Assignig of changed SQL string to executive pass-through query
If ObjectExists(acQuery, QueryName) Then
'If executive query exists, open it
Set qdf = db.QueryDefs(QueryName)
qdf.Connect = strConnect
Else
'If executive pass-thrpough query doesn't exist, create it
Set qdf = db.CreateQueryDef(QueryName)
qdf.Connect = strConnect
qdf.ODBCTimeout = 0
qdf.ReturnsRecords = True
End If
'Set SQL string
qdf.SQL = strSQLqdf.Close
Exit:
DoCmd.Hourglass False Exit Function
ErrorHandler:
Dim strErr As String
strErr = "VBA-Error Information" & vbNewLine
strErr = strErr & "Number: " & vbTab & vbTab & Err.Number & vbNewLine
strErr = strErr & "Description: " & vbTab & Err.Description & vbNewLine
strErr = strErr & "LastDLLError: " & vbTab & Err.LastDllError & vbNewLine
strErr = strErr & vbNewLine
MsgBox strErr, vbOKOnly + vbExclamation, "Error"
Resume Exit
End Function
Function ObjectExists(ObjType As Integer, objName As String) As Boolean 'Purpose: Determines whether or not a given object exists in database 'Example: If ObjectExists(acTable, "tblOrders") then ...
On Error Resume Next Dim db As DATABASE Dim strTemp As String, strContainer As String Set db = CurrentDb()
Select Case ObjType
Case acTable
strTemp = db.TableDefs(objName).Name
Case acQuery
strTemp = db.QueryDefs(objName).Name
Case acMacro, acModule, acForm, acReport
Select Case ObjType
Case acMacro
strContainer = "Scripts"
Case acModule
strContainer = "Modules"
Case acForm
strContainer = "Forms"
Case acReport
strContainer = "Reports"
End Select
strTemp = db.Containers(strContainer).Documents(objName).Name
End SelectObjectExists = (Err.Number = 0) End Function
---------------------------(end of broadcast)--------------------------- TIP 4: Don't 'kill -9' the postmaster
