Simple parameterized queries using ADO in VBA

You’re likely here because I referred you here to use parameters for your ADO queries. Using ADO queries is usually a tedious job, with a lot of reuse of code between different queries. You might have already found a tutorial, where the final code looked a little something like this:

Dim conn As ADODB.Connection
Set conn = CurrentProject.Connection
'Or: Set conn = New ADODB.Connection
'conn.ConnectionString = "the connectionstring"
'conn.Open
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = conn
cmd.CommandText = "INSERT INTO Table1(Field1, Field2) VALUES (@Value1, @Value2)"
Dim param1 As ADODB.Parameter
Set param1 = cmd.CreateParameter("@Value1", adVarWChar, adParamInput, 8, "David o'Connel says ""Hi!""")
cmd.Parameters.Append param1
Dim param2 As ADODB.Parameter
Set param2 = cmd.CreateParameter("@Value2", adInteger, adParamInput, 8, 15)
cmd.Parameters.Append param2
cmd.Execute

This, of course, is a tiny bit extreme, but a usual, optimal way to parameterize a query. However, doing so for every query would take a lot of time

Many steps can be automated. We want our end result to be way easier, like the following:

ExecuteParameters "INSERT INTO Table1(Field1, Field2) VALUES (@Value1, @Value2)", "David o'Connel says ""Hi!""", 15

And have the same end result. Let me outline the steps required for doing that.

(The following code has been tested under Microsoft Access, but should work under other VBA applications. It does require a reference to the Microsoft ActiveX Data Objects Library).

The first step for every query in ADO is creating the ADODB.Connection object. If you’re going to execute your query in Access, that’s pretty easy, it’s just CurrentProject.Connection. However, on SQL server, it’s a little more difficult.

The following assumes you’re going to use SQL server:

Let’s start at the top of our module, by declaring the connection string. Having a Public Const connectionString will help speed up coding a lot if you’re making a lot of database connections, and make it way easier when you need to move your database:

Public Const adoString As String = "DRIVER=SQL Server;SERVER=MyMSSQLServer;Trusted_Connection=Yes;APP=Microsoft Office 2010;DATABASE=MyDatabase;"

Then, let’s make a small function that returns an opened ADODB.Connection using that connection string:

>Public Function getConn() As ADODB.Connection
    'Returns an opened ADODB.Connection using a client-side cursor
    Set getConn = New ADODB.Connection
    getConn.CursorLocation = adUseClient
    getConn.Open adoString
End Function

If you’re going to use an Access connection, you can use the following function, which allows you to easily change the connection for all queries in the future:

Public Function getConn() As ADODB.Connection
    Set getConn = CurrentProject.Connection
End Function

One of the most difficult things we have to do with our easy query using parameters, is use the appropriate variable type. The function I’m going to use for that, is inspired by Gustav Brock’s CSQL. We’re going to map the different types in VBA to `ADODB.DataTypeEnum` enum values using `VarType`:

Public Function GetParameterType(parameter As Variant) As ADODB.DataTypeEnum
    'Dynamically determine parameter type
    'Inspired by Gustav Brock's CSql
    Dim LongLong As Integer
    #If Win32 Then
        LongLong = 20
    #End If
    #If Win64 Then
        LongLong = VBA.vbLongLong
    #End If
    
    Select Case VarType(parameter)
        Case vbEmpty            '    0  Empty (uninitialized).
            GoTo UnsupportedType
        Case vbNull             '    1  Null (no valid data).
            GoTo UnsupportedType
        Case vbInteger          '    2  Integer.
            GetParameterType = adInteger
        Case vbLong             '    3  Long integer.
            GetParameterType = adInteger
        Case vbSingle           '    4  Single-precision floating-point number.
            GetParameterType = adSingle
        Case vbDouble           '    5  Double-precision floating-point number.
            GetParameterType = adDouble
        Case vbCurrency         '    6  Currency.
            GetParameterType = adDecimal
        Case vbDate             '    7  Date.
            GetParameterType = adDate
        Case vbString           '    8  String.
            GetParameterType = adVarWChar 'Assumes strings are not long
        Case vbObject           '    9  Object.
            GoTo UnsupportedType
        Case vbError            '   10  Error.
            GoTo UnsupportedType
        Case vbBoolean          '   11  Boolean.
            GetParameterType = adBoolean
        Case vbVariant          '   12  Variant (used only with arrays of variants).
            GoTo UnsupportedType
        Case vbDataObject       '   13  A data access object.
            GoTo UnsupportedType
        Case vbDecimal          '   14  Decimal.
            GetParameterType = adDecimal
        Case vbByte             '   17  Byte.
            GetParameterType = adChar
        Case LongLong           '   20  LongLong integer (Valid on 64-bit platforms only).
            GetParameterType = adBigInt
        Case vbUserDefinedType  '   36  Variants that contain user-defined types.
            GoTo UnsupportedType
        Case vbArray            '   8192  Array.
            GoTo UnsupportedType
        Case Else               '   For example array + variant = 8204
            GoTo UnsupportedType
    End Select
    Exit Function
UnsupportedType:
    'MsgBox "Unsupported input parameter going to SQL statement!"
    'Stop
    'Prod: text will likely work
    GetParameterType = adVarWChar
End Function

Now, we can build our VBA function that executes the query, like we intend to. We have automated all the difficult steps. To pass the parameters, we’re going to use a ParamArray:

Public Function ExecuteParameters(sqlString As String, ParamArray Params() As Variant) As ADODB.Recordset
    'Executes a parameterized query using ADODB on the server using the input parameters, returns the recordset
    'Connection remains open, to close by ref counting when recordset expires
    Dim cmd As New ADODB.Command
    Dim inputParam As Variant
    cmd.ActiveConnection = getConn
    cmd.CommandText = sqlString
    For Each inputParam In Params
        Set inputParam = cmd.CreateParameter(, GetParameterType(inputParam), adParamInput, Len(Nz(inputParam, " ")), inputParam)
        cmd.Parameters.Append inputParam
    Next inputParam
    cmd.CommandType = adCmdText
    Set ExecuteParameters = cmd.Execute()
End Function

Since the function returns a recordset, we can both use it to open up recordsets using parameters, and to execute action queries:

'Executes an action query:
ExecuteParameters "INSERT INTO Table1(Field1, Field2) VALUES (?, ?)", "David o'Connel says ""Hi!""", 15
'Opens up a recordset
Dim rs As ADODB.Recordset
Set rs = ExecuteParameters("SELECT * FROM Table1 WHERE ID = ? OR Name Like  '%' & ?", 15, "o'Connel")