I have put together a small wrapper class to simplify creating parameterized ADODB queries with VB6/VBA. At this point I'm keeping things simple, so it's only supporting input parameters and from what I've tested it seems to work exactly as intended.
The main reason for writing this, is because creating SQL Injection -safe queries with ADODB involves creating an ADODB.Parameter for each parameter value, which can be combersome; to a beginner it's much easier to just concatenate the values into the command string.
The first thing I did was creating a "converter" class to take any value and spit out an ADODB.Parameter object - I called that class AdoValueConverter:
AdoValueConverter Class
Option Explicit
Public Function ToStringParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
Dim stringValue As String
stringValue = CStr(value)
Dim result As New ADODB.Parameter
With result
.type = adVarChar
.direction = direction
.size = Len(stringValue)
.value = stringValue
End With
Set ToStringParameter = result
End Function
Public Function ToIntegerParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
Dim integerValue As Long
integerValue = CLng(value)
Dim result As New ADODB.Parameter
With result
.type = adInteger
.direction = direction
.value = integerValue
End With
Set ToIntegerParameter = result
End Function
Public Function ToLongParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
Set ToLongParameter = ToIntegerParameter(value, direction)
End Function
Public Function ToDoubleParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
Dim doubleValue As Double
doubleValue = CDbl(value)
Dim result As New ADODB.Parameter
With result
.type = adDouble
.direction = direction
.value = doubleValue
End With
Set ToDoubleParameter = result
End Function
Public Function ToSingleParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
Dim singleValue As Single
singleValue = CSng(value)
Dim result As New ADODB.Parameter
With result
.type = adSingle
.direction = direction
.value = singleValue
End With
Set ToSingleParameter = result
End Function
Public Function ToCurrencyParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
Dim currencyValue As Currency
currencyValue = CCur(value)
Dim result As New ADODB.Parameter
With result
.type = adCurrency
.direction = direction
.value = currencyValue
End With
Set ToCurrencyParameter = result
End Function
Public Function ToBooleanParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
Dim boolValue As Boolean
boolValue = CBool(value)
Dim result As New ADODB.Parameter
With result
.type = adBoolean
.direction = direction
.value = boolValue
End With
Set ToBooleanParameter = result
End Function
Public Function ToDateParameter(ByVal value As Variant, ByVal direction As ADODB.ParameterDirectionEnum) As ADODB.Parameter
Dim dateValue As Date
dateValue = CDate(value)
Dim result As New ADODB.Parameter
With result
.type = adDate
.direction = direction
.value = dateValue
End With
Set ToDateParameter = result
End Function
Then I wrote the actual wrapper class, which I've called SqlCommand:
SqlCommand Class
Private converter As New AdoValueConverter
Option Explicit
Public Function Execute(connection As ADODB.connection, sql As String, ParamArray parameterValues()) As ADODB.Recordset
Dim cmd As New ADODB.Command
cmd.ActiveConnection = connection
cmd.CommandType = adCmdText
cmd.CommandText = sql
Dim i As Integer
Dim value As Variant
For i = LBound(parameterValues) To UBound(parameterValues)
value = parameterValues(i)
cmd.parameters.Append ToSqlInputParameter(value)
Next
Set Execute = cmd.Execute
End Function
Public Function SelectSingleValue(sql As String, ParamArray parameterValues()) As Variant
Dim connection As New ADODB.connection
connection.ConnectionString = Application.ConnectionString
connection.Open
Dim cmd As New ADODB.Command
cmd.ActiveConnection = connection
cmd.CommandType = adCmdText
cmd.CommandText = sql
Dim i As Integer
Dim value As Variant
For i = LBound(parameterValues) To UBound(parameterValues)
value = parameterValues(i)
cmd.parameters.Append ToSqlInputParameter(value)
Next
Dim rs As ADODB.Recordset
Set rs = cmd.Execute
Dim result As Variant
If Not rs.BOF And Not rs.EOF Then result = rs.Fields(0).value
rs.Close
Set rs = Nothing
connection.Close
Set connection = Nothing
SelectSingleValue = result
End Function
Public Function ExecuteNonQuery(connection As ADODB.connection, sql As String, ParamArray parameterValues()) As Boolean
Dim cmd As New ADODB.Command
cmd.ActiveConnection = connection
cmd.CommandType = adCmdText
cmd.CommandText = sql
Dim i As Integer
Dim value As Variant
For i = LBound(parameterValues) To UBound(parameterValues)
value = parameterValues(i)
cmd.parameters.Append ToSqlInputParameter(value)
Next
Dim result As Boolean
On Error Resume Next
cmd.Execute
result = (Err.Number = 0)
On Error GoTo 0
End Function
Private Function ToSqlInputParameter(ByVal value As Variant, Optional ByVal size As Integer, Optional ByVal precision As Integer) As ADODB.Parameter
Dim result As ADODB.Parameter
Set result = CallByName(converter, "To" & TypeName(value) & "Parameter", VbMethod, value, ADODB.ParameterDirectionEnum.adParamInput)
If size <> 0 Then result.size = size
If precision <> 0 Then result.precision = precision
Set ToSqlInputParameter = result
End Function
The Execute method returns a ADODB.Recordset object, and it's up to the client code to close it - the client code owns the connection being used.
The ExecuteNonQuery method returns a Boolean value indicating whether the command was executed successfully (that is, without throwing any errors) - again, the client code owns the connection being used.
The SelectSingleValue method returns a Variant value that represents the value of the first field of the first returned record, if anything is returned from the specified SQL statement.
Usage
Dim cmd As New SqlCommand
Dim result As Variant
result = cmd.SelectSingleValue("SELECT SomeField FROM SomeTable WHERE SomeValue = ?", 123)
Dim cmd As New SqlCommand
Dim result As ADODB.Recordset
Dim conn As New ADODB.Connection
conn.ConnectionString = "connection string"
conn.Open
Set result = cmd.Execute(conn, "SELECT * FROM SomeTable WHERE SomeField = ?", 123)
'use result
result.Close
conn.Close
Dim cmd As New SqlCommand
Dim conn As New ADODB.Connection
Dim result As Boolean
conn.ConnectionString = "connection string"
conn.Open
result = cmd.ExecuteNonQuery(conn, "UPDATE SomeTable SET SomeField = ? WHERE SomeValue = ?", 123, "abc")
conn.Close
Although the Precision doesn't get set (I have yet to figure that one out) for Double, Single and Currency parameters, tests have shown that all decimals are being correctly passed to the server, so there's [surprisingly] no immediately apparent bug here.
SqlCommand.SelectSingleValue("SELECT SomeField FROM SomeTable WHERE SomeValue = ?", 123)is all you need to code to get a full-fledged parameterized query, without the hassle of creating the parameters yourself. \$\endgroup\$