How to make parametrized update statement [duplicate] - vba
I've read a lot about SQL injection, and using parameters, from sources like bobby-tables.com. However, I'm working with a complex application in Access, that has a lot of dynamic SQL with string concatenation in all sorts of places.
It has the following things I want to change, and add parameters to, to avoid errors and allow me to handle names with single quotes, like Jack O'Connel.
It uses:
DoCmd.RunSQL to execute SQL commands
DAO recordsets
ADODB recordsets
Forms and reports, opened with DoCmd.OpenForm and DoCmd.OpenReport, using string concatenation in the WhereCondition argument
Domain aggregates like DLookUp that use string concatenation
The queries are mostly structured like this:
DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE ID = " & Me.SomeTextbox
What are my options to use parameters for these different kinds of queries?
This question is intended as a resource, for the frequent how do I use parameters comment on various posts
There are many ways to use parameters in queries. I will try to provide examples for most of them, and where they are applicable.
First, we'll discuss the solutions unique to Access, such as forms, reports and domain aggregates. Then, we'll talk about DAO and ADO.
Using values from forms and reports as parameters
In Access, you can directly use the current value of controls on forms and reports in your SQL code. This limits the need for parameters.
You can refer to controls in the following way:
Forms!MyForm!MyTextbox for a simple control on a form
Forms!MyForm!MySubform.Form!MyTextbox for a control on a subform
Reports!MyReport!MyTextbox for a control on a report
Sample implementation:
DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Forms!MyForm!MyTextbox" 'Inserts a single value
DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE ID = Forms!MyForm!MyTextbox" 'Inserts from a different table
This is available for the following uses:
When using DoCmd.RunSQL, normal queries (in the GUI), form and report record sources, form and report filters, domain aggregates, DoCmd.OpenForm and DoCmd.OpenReport
This is not available for the following uses:
When executing queries using DAO or ADODB (e.g. opening recordsets, CurrentDb.Execute)
Using TempVars as parameters
TempVars in Access are globally available variables, that can be set in VBA or using macro's. They can be reused for multiple queries.
Sample implementation:
TempVars!MyTempVar = Me.MyTextbox.Value 'Note: .Value is required
DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE ID = TempVars!MyTempVar"
TempVars.Remove "MyTempVar" 'Unset TempVar when you're done using it
Availability for TempVars is identical to that of values from forms and reports: not available for ADO and DAO, available for other uses.
I recommend TempVars for using parameters when opening forms or reports over referring to control names, since if the object opening it closes, the TempVars stay available. I recommend using unique TempVar names for every form or report, to avoid weirdness when refreshing forms or reports.
Using custom functions (UDFs) as parameters
Much like TempVars, you can use a custom function and static variables to store and retrieve values.
Sample implementation:
Option Compare Database
Option Explicit
Private ThisDate As Date
Public Function GetThisDate() As Date
If ThisDate = #12:00:00 AM# Then
' Set default value.
ThisDate = Date
End If
GetThisDate = ThisDate
End Function
Public Function SetThisDate(ByVal NewDate As Date) As Date
ThisDate = NewDate
SetThisDate = ThisDate
End Function
and then:
SetThisDate SomeDateValue ' Will store SomeDateValue in ThisDate.
DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE [SomeDateField] = GetThisDate()"
Also, a single function with an optional parameter may be created for both setting and getting the value of a private static variable:
Public Function ThisValue(Optional ByVal Value As Variant) As Variant
Static CurrentValue As Variant
' Define default return value.
Const DefaultValue As Variant = Null
If Not IsMissing(Value) Then
' Set value.
CurrentValue = Value
ElseIf IsEmpty(CurrentValue) Then
' Set default value
CurrentValue = DefaultValue
End If
' Return value.
ThisValue = CurrentValue
End Function
To set a value:
ThisValue "Some text value"
To get the value:
CurrentValue = ThisValue
In a query:
ThisValue "SomeText" ' Set value to filter on.
DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE [SomeField] = ThisValue()"
Using DoCmd.SetParameter
The uses of DoCmd.SetParameter are rather limited, so I'll be brief. It allows you to set a parameter for use in DoCmd.OpenForm, DoCmd.OpenReport and some other DoCmd statements, but it doesn't work with DoCmd.RunSQL, filters, DAO and ADO.
Sample implementation
DoCmd.SetParameter "MyParameter", Me.MyTextbox
DoCmd.OpenForm "MyForm",,, "ID = MyParameter"
Using DAO
In DAO, we can use the DAO.QueryDef object to create a query, set parameters, and then either open up a recordset or execute the query. You first set the queries' SQL, then use the QueryDef.Parameters collection to set the parameters.
In my example, I'm going to use implicit parameter types. If you want to make them explicit, add a PARAMETERS declaration to your query.
Sample implementation
'Execute query, unnamed parameters
With CurrentDb.CreateQueryDef("", "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE Field1 = ?p1 And Field2 = ?p2")
.Parameters(0) = Me.Field1
.Parameters(1) = Me.Field2
.Execute
End With
'Open recordset, named parameters
Dim rs As DAO.Recordset
With CurrentDb.CreateQueryDef("", "SELECT Field1 FROM Table2 WHERE Field1 = FirstParameter And Field2 = SecondParameter")
.Parameters!FirstParameter = Me.Field1 'Bang notation
.Parameters("SecondParameter").Value = Me.Field2 'More explicit notation
Set rs = .OpenRecordset
End With
While this is only available in DAO, you can set many things to DAO recordsets to make them use parameters, such as form recordsets, list box recordsets and combo box recordsets. However, since Access uses the text, and not the recordset, when sorting and filtering, those things may prove problematic if you do.
Using ADO
You can use parameters in ADO by using the ADODB.Command object. Use Command.CreateParameter to create parameters, and then append them to the Command.Parameters collection.
You can use the .Parameters collection in ADO to explicitly declare parameters, or pass a parameter array to the Command.Execute method to implicitly pass parameters.
ADO does not support named parameters. While you can pass a name, it's not processed.
Sample implementation:
'Execute query, unnamed parameters
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
With cmd
Set .ActiveConnection = CurrentProject.Connection 'Use a connection to the current database
.CommandText = "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE Field1 = ? And Field2 = ?"
.Parameters.Append .CreateParameter(, adVarWChar, adParamInput, Len(Me.Field1), Me.Field1) 'adVarWChar for text boxes that may contain unicode
.Parameters.Append .CreateParameter(, adInteger, adParamInput, 8, Me.Field2) 'adInteger for whole numbers (long or integer)
.Execute
End With
'Open recordset, implicit parameters
Dim rs As ADODB.Recordset
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
With cmd
Set .ActiveConnection = CurrentProject.Connection 'Use a connection to the current database
.CommandText = "SELECT Field1 FROM Table2 WHERE Field1 = #FirstParameter And Field2 = #SecondParameter"
Set rs = .Execute(,Array(Me.Field1, Me.Field2))
End With
The same limitations as opening DAO recordsets apply. While this way is limited to executing queries and opening recordsets, you can use those recordsets elsewhere in your application.
I have built a fairly basic query builder class to get around the mess of string concatenation and to handle the lack of named parameters. Creating a query is fairly simple.
Public Function GetQuery() As String
With New MSAccessQueryBuilder
.QueryBody = "SELECT * FROM tblEmployees"
.AddPredicate "StartDate > #StartDate OR StatusChangeDate > #StartDate"
.AddPredicate "StatusIndicator IN (#Active, #LeaveOfAbsence) OR Grade > #Grade"
.AddPredicate "Salary > #SalaryThreshhold"
.AddPredicate "Retired = #IsRetired"
.AddStringParameter "Active", "A"
.AddLongParameter "Grade", 10
.AddBooleanParameter "IsRetired", False
.AddStringParameter "LeaveOfAbsence", "L"
.AddCurrencyParameter "SalaryThreshhold", 9999.99#
.AddDateParameter "StartDate", #3/29/2018#
.QueryFooter = "ORDER BY ID ASC"
GetQuery = .ToString
End With
End Function
The output of the ToString() method looks like:
SELECT * FROM tblEmployees WHERE 1 = 1 AND (StartDate > #3/29/2018# OR StatusChangeDate > #3/29/2018#) AND (StatusIndicator IN ('A', 'L') OR Grade > 10) AND (Salary > 9999.99) AND (Retired = False) ORDER BY ID ASC;
Each predicate is wrapped in parens to handle linked AND/OR clauses, and parameters with the same name only have to be declared once. Full code is at my github and reproduced below. I also have a version for Oracle passthrough queries that uses ADODB parameters. Eventually, I'd like to wrap both in an IQueryBuilder interface.
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "MSAccessQueryBuilder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'#Folder("VBALibrary.Data")
'#Description("Provides tools to construct Microsoft Access SQL statements containing predicates and parameters.")
Option Explicit
Private Const mlngErrorNumber As Long = vbObjectError + 513
Private Const mstrClassName As String = "MSAccessQueryBuilder"
Private Const mstrParameterExistsErrorMessage As String = "A parameter with this name has already been added to the Parameters dictionary."
Private Type TSqlBuilder
QueryBody As String
QueryFooter As String
End Type
Private mobjParameters As Object
Private mobjPredicates As Collection
Private this As TSqlBuilder
' =============================================================================
' CONSTRUCTOR / DESTRUCTOR
' =============================================================================
Private Sub Class_Initialize()
Set mobjParameters = CreateObject("Scripting.Dictionary")
Set mobjPredicates = New Collection
End Sub
' =============================================================================
' PROPERTIES
' =============================================================================
'#Description("Gets or sets the query statement (SELECT, INSERT, UPDATE, DELETE), exclusive of any predicates.")
Public Property Get QueryBody() As String
QueryBody = this.QueryBody
End Property
Public Property Let QueryBody(ByVal Value As String)
this.QueryBody = Value
End Property
'#Description("Gets or sets post-predicate query statements (e.g., GROUP BY, ORDER BY).")
Public Property Get QueryFooter() As String
QueryFooter = this.QueryFooter
End Property
Public Property Let QueryFooter(ByVal Value As String)
this.QueryFooter = Value
End Property
' =============================================================================
' PUBLIC METHODS
' =============================================================================
'#Description("Maps a boolean parameter and its value to the query builder.")
'#Param("strName: The parameter's name.")
'#Param("blnValue: The parameter's value.")
Public Sub AddBooleanParameter(ByVal strName As String, ByVal blnValue As Boolean)
If mobjParameters.Exists(strName) Then
Err.Raise mlngErrorNumber, mstrClassName & ".AddBooleanParameter", mstrParameterExistsErrorMessage
Else
mobjParameters.Add strName, CStr(blnValue)
End If
End Sub
' =============================================================================
'#Description("Maps a currency parameter and its value to the query builder.")
'#Param("strName: The parameter's name.")
'#Param("curValue: The parameter's value.")
Public Sub AddCurrencyParameter(ByVal strName As String, ByVal curValue As Currency)
If mobjParameters.Exists(strName) Then
Err.Raise mlngErrorNumber, mstrClassName & ".AddCurrencyParameter", mstrParameterExistsErrorMessage
Else
mobjParameters.Add strName, CStr(curValue)
End If
End Sub
' =============================================================================
'#Description("Maps a date parameter and its value to the query builder.")
'#Param("strName: The parameter's name.")
'#Param("dtmValue: The parameter's value.")
Public Sub AddDateParameter(ByVal strName As String, ByVal dtmValue As Date)
If mobjParameters.Exists(strName) Then
Err.Raise mlngErrorNumber, mstrClassName & ".AddDateParameter", mstrParameterExistsErrorMessage
Else
mobjParameters.Add strName, "#" & CStr(dtmValue) & "#"
End If
End Sub
' =============================================================================
'#Description("Maps a long parameter and its value to the query builder.")
'#Param("strName: The parameter's name.")
'#Param("lngValue: The parameter's value.")
Public Sub AddLongParameter(ByVal strName As String, ByVal lngValue As Long)
If mobjParameters.Exists(strName) Then
Err.Raise mlngErrorNumber, mstrClassName & ".AddNumericParameter", mstrParameterExistsErrorMessage
Else
mobjParameters.Add strName, CStr(lngValue)
End If
End Sub
' =============================================================================
'#Description("Adds a predicate to the query's WHERE criteria.")
'#Param("strPredicate: The predicate text to be added.")
Public Sub AddPredicate(ByVal strPredicate As String)
mobjPredicates.Add "(" & strPredicate & ")"
End Sub
' =============================================================================
'#Description("Maps a string parameter and its value to the query builder.")
'#Param("strName: The parameter's name.")
'#Param("strValue: The parameter's value.")
Public Sub AddStringParameter(ByVal strName As String, ByVal strValue As String)
If mobjParameters.Exists(strName) Then
Err.Raise mlngErrorNumber, mstrClassName & ".AddStringParameter", mstrParameterExistsErrorMessage
Else
mobjParameters.Add strName, "'" & strValue & "'"
End If
End Sub
' =============================================================================
'#Description("Parses the query, its predicates, and any parameter values, and outputs an SQL statement.")
'#Returns("A string containing the parsed query.")
Public Function ToString() As String
Dim strPredicatesWithValues As String
Const strErrorSource As String = "QueryBuilder.ToString"
If this.QueryBody = vbNullString Then
Err.Raise mlngErrorNumber, strErrorSource, "No query body is currently defined. Unable to build valid SQL."
End If
ToString = this.QueryBody
strPredicatesWithValues = ReplaceParametersWithValues(GetPredicatesText)
EnsureParametersHaveValues strPredicatesWithValues
If Not strPredicatesWithValues = vbNullString Then
ToString = ToString & " " & strPredicatesWithValues
End If
If Not this.QueryFooter = vbNullString Then
ToString = ToString & " " & this.QueryFooter & ";"
End If
End Function
' =============================================================================
' PRIVATE METHODS
' =============================================================================
'#Description("Ensures that all parameters defined in the query have been provided a value.")
'#Param("strQueryText: The query text to verify.")
Private Sub EnsureParametersHaveValues(ByVal strQueryText As String)
Dim strUnmatchedParameter As String
Dim lngMatchedPoisition As Long
Dim lngWordEndPosition As Long
Const strProcedureName As String = "EnsureParametersHaveValues"
lngMatchedPoisition = InStr(1, strQueryText, "#", vbTextCompare)
If lngMatchedPoisition <> 0 Then
lngWordEndPosition = InStr(lngMatchedPoisition, strQueryText, Space$(1), vbTextCompare)
strUnmatchedParameter = Mid$(strQueryText, lngMatchedPoisition, lngWordEndPosition - lngMatchedPoisition)
End If
If Not strUnmatchedParameter = vbNullString Then
Err.Raise mlngErrorNumber, mstrClassName & "." & strProcedureName, "Parameter " & strUnmatchedParameter & " has not been provided a value."
End If
End Sub
' =============================================================================
'#Description("Combines each predicate in the predicates collection into a single string statement.")
'#Returns("A string containing the text of all predicates added to the query builder.")
Private Function GetPredicatesText() As String
Dim strPredicates As String
Dim vntPredicate As Variant
If mobjPredicates.Count > 0 Then
strPredicates = "WHERE 1 = 1"
For Each vntPredicate In mobjPredicates
strPredicates = strPredicates & " AND " & CStr(vntPredicate)
Next vntPredicate
End If
GetPredicatesText = strPredicates
End Function
' =============================================================================
'#Description("Replaces parameters in the predicates statements with their provided values.")
'#Param("strPredicates: The text of the query's predicates.")
'#Returns("A string containing the predicates text with its parameters replaces by their provided values.")
Private Function ReplaceParametersWithValues(ByVal strPredicates As String) As String
Dim vntKey As Variant
Dim strParameterName As String
Dim strParameterValue As String
Dim strPredicatesWithValues As String
Const strProcedureName As String = "ReplaceParametersWithValues"
strPredicatesWithValues = strPredicates
For Each vntKey In mobjParameters.Keys
strParameterName = CStr(vntKey)
strParameterValue = CStr(mobjParameters(vntKey))
If InStr(1, strPredicatesWithValues, "#" & strParameterName, vbTextCompare) = 0 Then
Err.Raise mlngErrorNumber, mstrClassName & "." & strProcedureName, "Parameter " & strParameterName & " was not found in the query."
Else
strPredicatesWithValues = Replace(strPredicatesWithValues, "#" & strParameterName, strParameterValue, 1, -1, vbTextCompare)
End If
Next vntKey
ReplaceParametersWithValues = strPredicatesWithValues
End Function
' =============================================================================
Related
Data Type Mismatch on SQL statement
I am trying to pull in column data from a table into a timer in VBA. In my table I have IntervalSeconds as a number. I'm trying to query the number of seconds to determine how long to set my counter for. Dim timeRemaining As Long (Form Variable) - used in multiple functionss Private Sub Form_Open(Cancel As Integer) Dim strSQL As String Me.Visible = False strSQL = "SELECT AccessControl.IntervalSeconds FROM AccessControl WHERE AccessControl.DatabaseName = '" & CurrentDb.Name & "'" timeRemaining = CLng(strSQL) DoCmd.OpenForm ("frmForceLogout") End Sub Every time I run the form I get a Type Mismatch error when I hit the timeRemaining = cLng(strSQL) line. Am I missing something?
You can use DLookup for such simple tasks: Private Sub Form_Open(Cancel As Integer) Dim Criteria As String Me.Visible = False Criteria = "DatabaseName = '" & CurrentDb.Name & "'" timeRemaining = DLookup("IntervalSeconds", "AccessControl", Criteria) DoCmd.OpenForm ("frmForceLogout") End Sub
DoCmd.RunSQL "INSERT INTO TABLE" Numeric Values missing [duplicate]
I've read a lot about SQL injection, and using parameters, from sources like bobby-tables.com. However, I'm working with a complex application in Access, that has a lot of dynamic SQL with string concatenation in all sorts of places. It has the following things I want to change, and add parameters to, to avoid errors and allow me to handle names with single quotes, like Jack O'Connel. It uses: DoCmd.RunSQL to execute SQL commands DAO recordsets ADODB recordsets Forms and reports, opened with DoCmd.OpenForm and DoCmd.OpenReport, using string concatenation in the WhereCondition argument Domain aggregates like DLookUp that use string concatenation The queries are mostly structured like this: DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE ID = " & Me.SomeTextbox What are my options to use parameters for these different kinds of queries? This question is intended as a resource, for the frequent how do I use parameters comment on various posts
There are many ways to use parameters in queries. I will try to provide examples for most of them, and where they are applicable. First, we'll discuss the solutions unique to Access, such as forms, reports and domain aggregates. Then, we'll talk about DAO and ADO. Using values from forms and reports as parameters In Access, you can directly use the current value of controls on forms and reports in your SQL code. This limits the need for parameters. You can refer to controls in the following way: Forms!MyForm!MyTextbox for a simple control on a form Forms!MyForm!MySubform.Form!MyTextbox for a control on a subform Reports!MyReport!MyTextbox for a control on a report Sample implementation: DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Forms!MyForm!MyTextbox" 'Inserts a single value DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE ID = Forms!MyForm!MyTextbox" 'Inserts from a different table This is available for the following uses: When using DoCmd.RunSQL, normal queries (in the GUI), form and report record sources, form and report filters, domain aggregates, DoCmd.OpenForm and DoCmd.OpenReport This is not available for the following uses: When executing queries using DAO or ADODB (e.g. opening recordsets, CurrentDb.Execute) Using TempVars as parameters TempVars in Access are globally available variables, that can be set in VBA or using macro's. They can be reused for multiple queries. Sample implementation: TempVars!MyTempVar = Me.MyTextbox.Value 'Note: .Value is required DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE ID = TempVars!MyTempVar" TempVars.Remove "MyTempVar" 'Unset TempVar when you're done using it Availability for TempVars is identical to that of values from forms and reports: not available for ADO and DAO, available for other uses. I recommend TempVars for using parameters when opening forms or reports over referring to control names, since if the object opening it closes, the TempVars stay available. I recommend using unique TempVar names for every form or report, to avoid weirdness when refreshing forms or reports. Using custom functions (UDFs) as parameters Much like TempVars, you can use a custom function and static variables to store and retrieve values. Sample implementation: Option Compare Database Option Explicit Private ThisDate As Date Public Function GetThisDate() As Date If ThisDate = #12:00:00 AM# Then ' Set default value. ThisDate = Date End If GetThisDate = ThisDate End Function Public Function SetThisDate(ByVal NewDate As Date) As Date ThisDate = NewDate SetThisDate = ThisDate End Function and then: SetThisDate SomeDateValue ' Will store SomeDateValue in ThisDate. DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE [SomeDateField] = GetThisDate()" Also, a single function with an optional parameter may be created for both setting and getting the value of a private static variable: Public Function ThisValue(Optional ByVal Value As Variant) As Variant Static CurrentValue As Variant ' Define default return value. Const DefaultValue As Variant = Null If Not IsMissing(Value) Then ' Set value. CurrentValue = Value ElseIf IsEmpty(CurrentValue) Then ' Set default value CurrentValue = DefaultValue End If ' Return value. ThisValue = CurrentValue End Function To set a value: ThisValue "Some text value" To get the value: CurrentValue = ThisValue In a query: ThisValue "SomeText" ' Set value to filter on. DoCmd.RunSQL "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE [SomeField] = ThisValue()" Using DoCmd.SetParameter The uses of DoCmd.SetParameter are rather limited, so I'll be brief. It allows you to set a parameter for use in DoCmd.OpenForm, DoCmd.OpenReport and some other DoCmd statements, but it doesn't work with DoCmd.RunSQL, filters, DAO and ADO. Sample implementation DoCmd.SetParameter "MyParameter", Me.MyTextbox DoCmd.OpenForm "MyForm",,, "ID = MyParameter" Using DAO In DAO, we can use the DAO.QueryDef object to create a query, set parameters, and then either open up a recordset or execute the query. You first set the queries' SQL, then use the QueryDef.Parameters collection to set the parameters. In my example, I'm going to use implicit parameter types. If you want to make them explicit, add a PARAMETERS declaration to your query. Sample implementation 'Execute query, unnamed parameters With CurrentDb.CreateQueryDef("", "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE Field1 = ?p1 And Field2 = ?p2") .Parameters(0) = Me.Field1 .Parameters(1) = Me.Field2 .Execute End With 'Open recordset, named parameters Dim rs As DAO.Recordset With CurrentDb.CreateQueryDef("", "SELECT Field1 FROM Table2 WHERE Field1 = FirstParameter And Field2 = SecondParameter") .Parameters!FirstParameter = Me.Field1 'Bang notation .Parameters("SecondParameter").Value = Me.Field2 'More explicit notation Set rs = .OpenRecordset End With While this is only available in DAO, you can set many things to DAO recordsets to make them use parameters, such as form recordsets, list box recordsets and combo box recordsets. However, since Access uses the text, and not the recordset, when sorting and filtering, those things may prove problematic if you do. Using ADO You can use parameters in ADO by using the ADODB.Command object. Use Command.CreateParameter to create parameters, and then append them to the Command.Parameters collection. You can use the .Parameters collection in ADO to explicitly declare parameters, or pass a parameter array to the Command.Execute method to implicitly pass parameters. ADO does not support named parameters. While you can pass a name, it's not processed. Sample implementation: 'Execute query, unnamed parameters Dim cmd As ADODB.Command Set cmd = New ADODB.Command With cmd Set .ActiveConnection = CurrentProject.Connection 'Use a connection to the current database .CommandText = "INSERT INTO Table1(Field1) SELECT Field1 FROM Table2 WHERE Field1 = ? And Field2 = ?" .Parameters.Append .CreateParameter(, adVarWChar, adParamInput, Len(Me.Field1), Me.Field1) 'adVarWChar for text boxes that may contain unicode .Parameters.Append .CreateParameter(, adInteger, adParamInput, 8, Me.Field2) 'adInteger for whole numbers (long or integer) .Execute End With 'Open recordset, implicit parameters Dim rs As ADODB.Recordset Dim cmd As ADODB.Command Set cmd = New ADODB.Command With cmd Set .ActiveConnection = CurrentProject.Connection 'Use a connection to the current database .CommandText = "SELECT Field1 FROM Table2 WHERE Field1 = #FirstParameter And Field2 = #SecondParameter" Set rs = .Execute(,Array(Me.Field1, Me.Field2)) End With The same limitations as opening DAO recordsets apply. While this way is limited to executing queries and opening recordsets, you can use those recordsets elsewhere in your application.
I have built a fairly basic query builder class to get around the mess of string concatenation and to handle the lack of named parameters. Creating a query is fairly simple. Public Function GetQuery() As String With New MSAccessQueryBuilder .QueryBody = "SELECT * FROM tblEmployees" .AddPredicate "StartDate > #StartDate OR StatusChangeDate > #StartDate" .AddPredicate "StatusIndicator IN (#Active, #LeaveOfAbsence) OR Grade > #Grade" .AddPredicate "Salary > #SalaryThreshhold" .AddPredicate "Retired = #IsRetired" .AddStringParameter "Active", "A" .AddLongParameter "Grade", 10 .AddBooleanParameter "IsRetired", False .AddStringParameter "LeaveOfAbsence", "L" .AddCurrencyParameter "SalaryThreshhold", 9999.99# .AddDateParameter "StartDate", #3/29/2018# .QueryFooter = "ORDER BY ID ASC" GetQuery = .ToString End With End Function The output of the ToString() method looks like: SELECT * FROM tblEmployees WHERE 1 = 1 AND (StartDate > #3/29/2018# OR StatusChangeDate > #3/29/2018#) AND (StatusIndicator IN ('A', 'L') OR Grade > 10) AND (Salary > 9999.99) AND (Retired = False) ORDER BY ID ASC; Each predicate is wrapped in parens to handle linked AND/OR clauses, and parameters with the same name only have to be declared once. Full code is at my github and reproduced below. I also have a version for Oracle passthrough queries that uses ADODB parameters. Eventually, I'd like to wrap both in an IQueryBuilder interface. VERSION 1.0 CLASS BEGIN MultiUse = -1 'True END Attribute VB_Name = "MSAccessQueryBuilder" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = True Attribute VB_PredeclaredId = False Attribute VB_Exposed = True '#Folder("VBALibrary.Data") '#Description("Provides tools to construct Microsoft Access SQL statements containing predicates and parameters.") Option Explicit Private Const mlngErrorNumber As Long = vbObjectError + 513 Private Const mstrClassName As String = "MSAccessQueryBuilder" Private Const mstrParameterExistsErrorMessage As String = "A parameter with this name has already been added to the Parameters dictionary." Private Type TSqlBuilder QueryBody As String QueryFooter As String End Type Private mobjParameters As Object Private mobjPredicates As Collection Private this As TSqlBuilder ' ============================================================================= ' CONSTRUCTOR / DESTRUCTOR ' ============================================================================= Private Sub Class_Initialize() Set mobjParameters = CreateObject("Scripting.Dictionary") Set mobjPredicates = New Collection End Sub ' ============================================================================= ' PROPERTIES ' ============================================================================= '#Description("Gets or sets the query statement (SELECT, INSERT, UPDATE, DELETE), exclusive of any predicates.") Public Property Get QueryBody() As String QueryBody = this.QueryBody End Property Public Property Let QueryBody(ByVal Value As String) this.QueryBody = Value End Property '#Description("Gets or sets post-predicate query statements (e.g., GROUP BY, ORDER BY).") Public Property Get QueryFooter() As String QueryFooter = this.QueryFooter End Property Public Property Let QueryFooter(ByVal Value As String) this.QueryFooter = Value End Property ' ============================================================================= ' PUBLIC METHODS ' ============================================================================= '#Description("Maps a boolean parameter and its value to the query builder.") '#Param("strName: The parameter's name.") '#Param("blnValue: The parameter's value.") Public Sub AddBooleanParameter(ByVal strName As String, ByVal blnValue As Boolean) If mobjParameters.Exists(strName) Then Err.Raise mlngErrorNumber, mstrClassName & ".AddBooleanParameter", mstrParameterExistsErrorMessage Else mobjParameters.Add strName, CStr(blnValue) End If End Sub ' ============================================================================= '#Description("Maps a currency parameter and its value to the query builder.") '#Param("strName: The parameter's name.") '#Param("curValue: The parameter's value.") Public Sub AddCurrencyParameter(ByVal strName As String, ByVal curValue As Currency) If mobjParameters.Exists(strName) Then Err.Raise mlngErrorNumber, mstrClassName & ".AddCurrencyParameter", mstrParameterExistsErrorMessage Else mobjParameters.Add strName, CStr(curValue) End If End Sub ' ============================================================================= '#Description("Maps a date parameter and its value to the query builder.") '#Param("strName: The parameter's name.") '#Param("dtmValue: The parameter's value.") Public Sub AddDateParameter(ByVal strName As String, ByVal dtmValue As Date) If mobjParameters.Exists(strName) Then Err.Raise mlngErrorNumber, mstrClassName & ".AddDateParameter", mstrParameterExistsErrorMessage Else mobjParameters.Add strName, "#" & CStr(dtmValue) & "#" End If End Sub ' ============================================================================= '#Description("Maps a long parameter and its value to the query builder.") '#Param("strName: The parameter's name.") '#Param("lngValue: The parameter's value.") Public Sub AddLongParameter(ByVal strName As String, ByVal lngValue As Long) If mobjParameters.Exists(strName) Then Err.Raise mlngErrorNumber, mstrClassName & ".AddNumericParameter", mstrParameterExistsErrorMessage Else mobjParameters.Add strName, CStr(lngValue) End If End Sub ' ============================================================================= '#Description("Adds a predicate to the query's WHERE criteria.") '#Param("strPredicate: The predicate text to be added.") Public Sub AddPredicate(ByVal strPredicate As String) mobjPredicates.Add "(" & strPredicate & ")" End Sub ' ============================================================================= '#Description("Maps a string parameter and its value to the query builder.") '#Param("strName: The parameter's name.") '#Param("strValue: The parameter's value.") Public Sub AddStringParameter(ByVal strName As String, ByVal strValue As String) If mobjParameters.Exists(strName) Then Err.Raise mlngErrorNumber, mstrClassName & ".AddStringParameter", mstrParameterExistsErrorMessage Else mobjParameters.Add strName, "'" & strValue & "'" End If End Sub ' ============================================================================= '#Description("Parses the query, its predicates, and any parameter values, and outputs an SQL statement.") '#Returns("A string containing the parsed query.") Public Function ToString() As String Dim strPredicatesWithValues As String Const strErrorSource As String = "QueryBuilder.ToString" If this.QueryBody = vbNullString Then Err.Raise mlngErrorNumber, strErrorSource, "No query body is currently defined. Unable to build valid SQL." End If ToString = this.QueryBody strPredicatesWithValues = ReplaceParametersWithValues(GetPredicatesText) EnsureParametersHaveValues strPredicatesWithValues If Not strPredicatesWithValues = vbNullString Then ToString = ToString & " " & strPredicatesWithValues End If If Not this.QueryFooter = vbNullString Then ToString = ToString & " " & this.QueryFooter & ";" End If End Function ' ============================================================================= ' PRIVATE METHODS ' ============================================================================= '#Description("Ensures that all parameters defined in the query have been provided a value.") '#Param("strQueryText: The query text to verify.") Private Sub EnsureParametersHaveValues(ByVal strQueryText As String) Dim strUnmatchedParameter As String Dim lngMatchedPoisition As Long Dim lngWordEndPosition As Long Const strProcedureName As String = "EnsureParametersHaveValues" lngMatchedPoisition = InStr(1, strQueryText, "#", vbTextCompare) If lngMatchedPoisition <> 0 Then lngWordEndPosition = InStr(lngMatchedPoisition, strQueryText, Space$(1), vbTextCompare) strUnmatchedParameter = Mid$(strQueryText, lngMatchedPoisition, lngWordEndPosition - lngMatchedPoisition) End If If Not strUnmatchedParameter = vbNullString Then Err.Raise mlngErrorNumber, mstrClassName & "." & strProcedureName, "Parameter " & strUnmatchedParameter & " has not been provided a value." End If End Sub ' ============================================================================= '#Description("Combines each predicate in the predicates collection into a single string statement.") '#Returns("A string containing the text of all predicates added to the query builder.") Private Function GetPredicatesText() As String Dim strPredicates As String Dim vntPredicate As Variant If mobjPredicates.Count > 0 Then strPredicates = "WHERE 1 = 1" For Each vntPredicate In mobjPredicates strPredicates = strPredicates & " AND " & CStr(vntPredicate) Next vntPredicate End If GetPredicatesText = strPredicates End Function ' ============================================================================= '#Description("Replaces parameters in the predicates statements with their provided values.") '#Param("strPredicates: The text of the query's predicates.") '#Returns("A string containing the predicates text with its parameters replaces by their provided values.") Private Function ReplaceParametersWithValues(ByVal strPredicates As String) As String Dim vntKey As Variant Dim strParameterName As String Dim strParameterValue As String Dim strPredicatesWithValues As String Const strProcedureName As String = "ReplaceParametersWithValues" strPredicatesWithValues = strPredicates For Each vntKey In mobjParameters.Keys strParameterName = CStr(vntKey) strParameterValue = CStr(mobjParameters(vntKey)) If InStr(1, strPredicatesWithValues, "#" & strParameterName, vbTextCompare) = 0 Then Err.Raise mlngErrorNumber, mstrClassName & "." & strProcedureName, "Parameter " & strParameterName & " was not found in the query." Else strPredicatesWithValues = Replace(strPredicatesWithValues, "#" & strParameterName, strParameterValue, 1, -1, vbTextCompare) End If Next vntKey ReplaceParametersWithValues = strPredicatesWithValues End Function ' =============================================================================
How to check efficient whether a recordset value isnull before passing it to a called function?
I have a sub which creates a recordset. A function is called with values from the recordset. The goal is to use multiple values from the recordset, however, there is a possibility that a recordset value is null, then the function call will result in an error: "Invalid use of Null". To handle this error, each time the recordset value is checked for null values, if it is null, it will be replaced with an empty string. However, the way I have programmed this feels very inefficient, even more when later on more than ten parameters should be checked. Is there a way to do this more efficiently? I have skipped the last part off the code as this is not necessary to understand my question. I've replaced it with ......... If needed, I will edit and provide full code. Sub CallFunctionWithArray() Dim conn As ADODB.Connection Dim rst As ADODB.Recordset Dim arrValues(1 To 3) As Variant Set conn = New ADODB.Connection conn.Open "provider=Microsoft.JET.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\Northwind.mdb" Set rst = New ADODB.Recordset rst.Open "SELECT * FROM CustomersCopy", conn, adOpenForwardOnly, adLockReadOnly, adCmdText If Not (rst.EOF And rst.BOF) Then rst.MoveFirst Do Until rst.EOF = True If IsNull(rst![CompanyName]) Then arrValues(1) = "" Else arrValues(1) = rst![CompanyName] End If If IsNull(rst![DateTest]) Then arrValues(2) = "" Else arrValues(2) = rst![DateTest] End If If IsNull(rst![INTTest]) Then arrValues(3) = "" Else arrValues(3) = rst![INTTest] End If Call ReturnValuesOfArray(arrValues(1), arrValues(2), arrValues(3)) ......... End Sub Function ReturnValuesOfArray(ByVal ValueOne As String, ByVal ValueTwo As String, ByVal ValueThree As String) Debug.Print "Waarde variabele 1: " & ValueOne Debug.Print "Waarde variabele 2: " & ValueTwo Debug.Print "Waarde variabele 3: " & ValueThree End Function There is no problem with the code, it does what it's supposed to do. However, I will be passing many more parameters to the function when this is going to be really used.
You could loop through the fields of your Recordset instead of hard coding for every field. Using your code as a starting point, it could look something like this: Private Sub Test() Dim rst As ADODB.Recordset Dim i As Integer If Not (rst.EOF And rst.BOF) Then rst.MoveFirst Do Until rst.EOF = True For i = 0 To rst.Fields.Count - 1 If IsNull(rst.Fields(i).Value) Then arrValues(i) = "" Else arrValues(i) = rst.Fields(i).Value End If Next Loop End If End Sub Incorporating the ideas presented by #HansUp and #Mathieu Guindon, the code is even shorter: Private Sub Test() Dim rst As ADODB.Recordset Dim i As Integer Do Until rst.EOF For i = 0 To rst.Fields.Count - 1 arrValues(i + 1) = Nz(rst.Fields(i).Value, "") Next Loop End Sub The rest of your code can be simplified, too, while allowing for any number of parameters: Function ReturnValuesOfArray(ByVal Values As Variant) Dim i As Integer For i = LBound(Values) To UBound(Values) Debug.Print "Waarde variabele " & i & ": " & Values(i) Next End Function
The Nz Function does what I think you want. arrValues(1) = Nz(rst![CompanyName], "") arrValues(2) = Nz(rst![DateTest], "") arrValues(3) = Nz(rst![INTTest], "")
how to calculate median in Access query using function in VBa
I'm using ms Access query to calculate the MEdian AGe of Patients grouped by Clinic name using Query. since Access doesn't have build-in Median function. I have to create it using VBA, I tried many ready functions from web.. but none worked properly. any suggestions for working codes around? could u plz help me to get the median! thank u in advance.
This is a good function also pretty well commented: Public Function acbDMedian( _ ByVal strField As String, ByVal strDomain As String, _ Optional ByVal strCriteria As String) As Variant ' Purpose: ' To calculate the median value ' for a field in a table or query. ' In: ' strField: The field ' strDomain: The table or query ' strCriteria: An optional WHERE clause to ' apply to the table or query ' Out: ' Return value: The median, if successful; ' otherwise, an error value Dim db As DAO.Database Dim rstDomain As DAO.Recordset Dim strSQL As String Dim varMedian As Variant Dim intFieldType As Integer Dim intRecords As Integer Const acbcErrAppTypeError = 3169 On Error GoTo HandleErr Set db = CurrentDb( ) ' Initialize the return value. varMedian = Null ' Build a SQL string for the recordset. strSQL = "SELECT " & strField strSQL = strSQL & " FROM " & strDomain ' Use a WHERE clause only if one is passed in. If Len(strCriteria) > 0 Then strSQL = strSQL & " WHERE " & strCriteria End If strSQL = strSQL & " ORDER BY " & strField Set rstDomain = db.OpenRecordset(strSQL, dbOpenSnapshot) ' Check the data type of the median field. intFieldType = rstDomain.Fields(strField).Type Select Case intFieldType Case dbByte, dbInteger, dbLong, dbCurrency, dbSingle, dbDouble, dbDate ' Numeric field. If Not rstDomain.EOF Then rstDomain.MoveLast intRecords = rstDomain.RecordCount ' Start from the first record. rstDomain.MoveFirst If (intRecords Mod 2) = 0 Then ' Even number of records. No middle record, so move ' to the record right before the middle. rstDomain.Move ((intRecords \ 2) - 1) varMedian = rstDomain.Fields(strField) ' Now move to the next record, the one right after ' the middle. rstDomain.MoveNext ' Average the two values. varMedian = (varMedian + rstDomain.Fields(strField)) / 2 ' Make sure you return a date, even when averaging ' two dates. If intFieldType = dbDate And Not IsNull(varMedian) Then varMedian = CDate(varMedian) End If Else ' Odd number of records. Move to the middle record ' and return its value. rstDomain.Move ((intRecords \ 2)) varMedian = rstDomain.Fields(strField) End If Else ' No records; return Null. varMedian = Null End If Case Else ' Nonnumeric field; raise an app error. Err.Raise acbcErrAppTypeError End Select acbDMedian = varMedian ExitHere: On Error Resume Next rstDomain.Close Set rstDomain = Nothing Exit Function HandleErr: ' Return an error value. acbDMedian = CVErr(Err) Resume ExitHere End Function Source: http://etutorials.org/Microsoft+Products/access/Chapter+6.+Data/Recipe+6.4+Find+the+Median+Value+for+a+Field/
VBA function to a field name
I have the same copy of a function in many forms that does exactly the same job. What changes in them is a field name. So the reason I keep it local is I don't know how I would refer to a particular field by name in a referenced form. This is the function: Private Function getNewXNo(ByRef theForm As Form, ByVal strCode As String) As String Dim rs As DAO.Recordset Dim maxNo As Long Dim aNo As Long Set rs = theForm.RecordsetClone maxNo = 0 If rs.RecordCount <> 0 Then rs.MoveFirst Do While Not rs.EOF aNo = CLng(Right(Nz(rs!applicationNo, strCode & "0000"), 4)) If aNo > maxNo Then maxNo = aNo End If rs.MoveNext Loop End If getNewXNo = strCode & Format(maxNo + 1, " Set rs = Nothing End Function There are a lot of instances when I have to generate new codes, such as BB001, BB002, APP001, APP002, etc. The function reads all existing codes from a field in the referenced form and based on that creates a new one. Is there any way I can send a field name to a global function, such as aNo = CLng(Right(Nz(rs!varThatContainsAFieldName, strCode & "0000"), 4)) Thanks
You can access a field in a recordset like this: rs("fieldname") So you could make the field name a parameter for your function.