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 If
qdf.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 = strSQL
qdf.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).Nam e
End Select
ObjectExists = (Err.Number = 0)
End Function
