Excel VBA QueryTable Parameter Fails with Null Val

问题:

Is it possible to pass a NULL value to QueryTable.Parameters for use in a (My)SQL query?

From this other answer, we can see that it's possible to do this with ADODB.Command, but unfortunately, ADODB is not available in Excel for Mac, and the application I'm developing should work on both Windows & Mac.

The below is confirmed to error with Windows (and I'd assume Mac).

The following VBA code works fine if you set param_value to anything but Null, but as soon as you try with a Null, it fails terribly.

Option Explicit

Sub Test()
    ' SQL '
    Dim sql As String
    sql = "SELECT ? AS `something`"

    Dim param_value As Variant
    'param_value = "hello"       ' this works
    'param_value = Null          ' this does NOT work

    ' QUERY & TABLE CONFIG '
    Dim my_dsn As String
    Dim sheet_name As String
    Dim sheet_range As Range
    Dim table_name As String

    my_dsn = "ODBC;DSN=my_dsn;"
    sheet_name = "Sheet1"
    Set sheet_range = Range("$A$1")
    table_name = "test_table"

    ' EXECUTE QUERY '
    Dim qt As QueryTable
    Set qt = ActiveWorkbook.Worksheets(sheet_name).ListObjects.Add( _
        SourceType:=xlSrcExternal, _
        Source:=my_dsn, _
        Destination:=sheet_range _
    ).QueryTable

    With qt
        .ListObject.Name = table_name
        .ListObject.DisplayName = table_name
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = False
        .CommandText = sql
    End With

    Dim param As Parameter
    Set param = qt.Parameters.Add( _
        "param for something", _
        xlParamTypeUnknown _
    )
    param.SetParam xlConstant, param_value

    qt.Refresh BackgroundQuery:=False
End Sub

---

When setting param_value to "hello", the successful result looks like this:

(This bottom part with command prompt screenshot is what was recorded by MySQL's logging).

---

This is the error when setting param_value to Null:

You can see from the MySQL log that the successful query first does a Prepare, followed by an Execute of the query.

Whereas the failing, Null query does the Prepare, but never makes it to the Execute.

Searching online for run-time error -2147417848 (80010108) is no help; people report getting that for everything from "freeze pane" issues to "userform" issues, and I don't see anything about this related to QueryTable.

---

Not only does the VBA code fail to work as expected, it also corrupts the workbook in some way:

(This occurs when attempting to save the file after the failed query; close without saving and you can re-open).

---

The fact that the MySQL log is showing the VBA connection failing to Quit, and that the Excel file gets corrupted, makes me think that not only is it not possible to use Null in QueryTable.Parameters, but that it is also a bug in the underlying software.

Am I missing something, or is it impossible to pass a Null Parameter to a QueryTable?

Update

In response to close votes: my point is that there should be a way to pass a parameter as NULL, just as is referenced here.

Update

Due to this issue with Null, as well as xlParamTypeDate not being converted from a decimal to 'yyyy-mm-dd', I ended up rolling my own parameterizing class module. It has been posted below as an answer to this question.

回答1:

If anyone knows how to accomplish this with QueryTable.Parameters, then post and I'll select your answer. But following is a custom solution.

For all SqlTypes except char, the parameterization is custom, but char still uses QueryTable.Parameters due to the various escaping corner cases that can occur when trying to implement that.

Edit to above strikethrough: I have actually reverted to also manually handling char params with this custom parameterization. I forget the exact corner case encountered, but the definitive conclusion reached was that the VBA parameterization was failing for a singular case of a specific char param with a specific query string... I have absolutely no idea where the point of failure was as it was generated within the black-box of Microsoft's VBA method, but I validated as a factual certainty that the string param was simply not getting passed to the (My)SQL engine for this one seemingly random case. Suffice it to say that my experience has been that the QueryTable.Parameters method can simply not be trusted at all. My recommendation is to uncomment the line of GetValueAsSqlString = Replace$(Replace$(Replace$(CStr(value), "\", "\\"), "'", "\'"), """", "\""") and to remove the IF char THEN logic within SetQueryTableSqlAndParams. Since different engines have different literal characters, I leave this as an exercise for the reader to handle in their circumstance; for example, the above Replace$() code may (or may not) have the behavior you desire to see with a VBA string containing \n.

One inconsistency I noticed with QueryTable is that if you execute a non-parameterized query of SELECT "hello\r\nthere" AS s, the query will return with a newline (as expected), but if you use QueryTable.Parameters xlParamTypeChar with "hello\r\nthere", then it will return with raw backslashes. So you must use vbCrLf, etc. when parameterizing string literals.

SqlParams class module:

Option Explicit

' https://web.archive.org/web/20180304004843/http://analystcave.com:80/vba-enum-using-enumerations-in-vba/#Enumerating_a_VBA_Enum '
Public Enum SqlTypes
    [_First]
    bool
    char
    num_integer
    num_fractional
    dt_date
    dt_time
    dt_datetime
    [_Last]
End Enum

Private substitute_string As String
Private Const priv_sql_type_index As Integer = 0
Private Const priv_sql_val_index As Integer = 1
Private params As New collection

Private Sub Class_Initialize()
    substitute_string = "?"
End Sub

Public Property Get SubstituteString() As String
    ' This is the string to place in the query '
    '  i.e. "SELECT * FROM users WHERE id = ?" '

    SubstituteString = substitute_string
End Property

Public Property Let SubstituteString(ByVal s As String)
    substitute_string = s
End Property

Public Sub SetQueryTableSqlAndParams( _
 ByVal qt As QueryTable, _
 ByVal sql As String _
 )
    Dim str_split As Variant
    str_split = Split(sql, substitute_string)

    Call Assert( _
        (GetArrayLength(str_split) - 1) = params.Count, _
        "Found " & (GetArrayLength(str_split) - 1) & ", but expected to find " & params.Count & " of '" & substitute_string & "' in '" & sql & "'" _
    )

    qt.Parameters.Delete

    sql = str_split(0)
    Dim param_n As Integer
    For param_n = 1 To params.Count
        If (GetSqlType(param_n) = SqlTypes.char) And Not IsNull(GetValue(param_n)) Then
            sql = sql & "?"

            With qt.Parameters.Add( _
                    param_n, _
                    xlParamTypeChar _
                )
                .SetParam xlConstant, GetValue(param_n)
            End With
        Else
            sql = sql & GetValueAsSqlString(param_n)
        End If

        sql = sql & str_split(param_n)
    Next param_n

    qt.CommandText = sql
End Sub

Public Property Get Count() As Integer
    Count = params.Count
End Property

Public Sub Add( _
 ByVal sql_type As SqlTypes, _
 ByVal value As Variant _
 )
    Dim val_array(1)
    val_array(priv_sql_type_index) = sql_type
    Call SetThisToThat(val_array(priv_sql_val_index), value)

    params.Add val_array
End Sub

Public Function GetSqlType(ByVal index_n As Integer) As SqlTypes
    GetSqlType = params.Item(index_n)(priv_sql_type_index)
End Function

Public Function GetValue(ByVal index_n As Integer) As Variant
    Call SetThisToThat( _
        GetValue, _
        params.Item(index_n)(priv_sql_val_index) _
    )
End Function

Public Sub Update( _
 ByVal index_n As Integer, _
 ByVal sql_type As SqlTypes, _
 ByVal value As Variant _
 )
    Call SetSqlType(index_n, sql_type)
    Call SetValue(index_n, value)
End Sub

Public Sub SetSqlType( _
 ByVal index_n As Integer, _
 ByVal sql_type As SqlTypes _
 )
    params.Item(index_n)(priv_sql_type_index) = sql_type
End Sub

Public Sub SetValue( _
 ByVal index_n As Integer, _
 ByVal value As Variant _
 )
    Call SetThisToThat( _
        params.Item(index_n)(priv_sql_val_index), _
        value _
    )
End Sub

Public Function GetValueAsSqlString(index_n As Integer) As String
    Dim value As Variant
    Call SetThisToThat(value, GetValue(index_n))

    If IsNull(value) Then
        GetValueAsSqlString = "NULL"
    Else
        Dim sql_type As SqlTypes
        sql_type = GetSqlType(index_n)

        Select Case sql_type
            Case SqlTypes.num_integer
                GetValueAsSqlString = CStr(value)
                Call Assert( _
                    StringIsInteger(GetValueAsSqlString), _
                    "Expected integer, but found " & GetValueAsSqlString, _
                    "GetValueAsSqlString" _
                )
            Case SqlTypes.num_fractional
                GetValueAsSqlString = CStr(value)
                Call Assert( _
                    StringIsFractional(GetValueAsSqlString), _
                    "Expected fractional, but found " & GetValueAsSqlString, _
                    "GetValueAsSqlString" _
                )
            Case SqlTypes.bool
                If (value = True) Or (value = 1) Then
                    GetValueAsSqlString = "1"
                ElseIf (value = False) Or (value = 0) Then
                    GetValueAsSqlString = "0"
                Else
                    err.Raise 5, "GetValueAsSqlString", _
                        "Expected bool of True/False or 1/0, but found " & value
                End If
            Case Else
                ' Everything below will be wrapped in quotes as a string for SQL '

                Select Case sql_type
                    Case SqlTypes.char
                        err.Raise 5, "GetValueAsSqlString", _
                            "Use 'QueryTable.Parameters.Add' for chars"

                        ' GetValueAsSqlString = Replace$(Replace$(Replace$(CStr(value), "\", "\\"), "'", "\'"), """", "\""") ''
                    Case SqlTypes.dt_date
                        If VarType(value) = vbString Then
                            GetValueAsSqlString = value
                        Else
                            GetValueAsSqlString = Format(value, "yyyy-MM-dd")
                        End If

                        Call Assert( _
                            StringIsSqlDate(GetValueAsSqlString), _
                            "Expected date as yyyy-mm-dd , but found " & GetValueAsSqlString, _
                            "GetValueAsSqlString" _
                        )
                    Case SqlTypes.dt_datetime
                        If VarType(value) = vbString Then
                            GetValueAsSqlString = value
                        Else
                            GetValueAsSqlString = Format(value, "yyyy-MM-dd hh:mm:ss")
                        End If

                        Call Assert( _
                            StringIsSqlDatetime(GetValueAsSqlString), _
                            "Expected datetime as yyyy-mm-dd hh:mm:ss, but found " & GetValueAsSqlString, _
                            "GetValueAsSqlString" _
                        )
                    Case SqlTypes.dt_time
                        If VarType(value) = vbString Then
                            GetValueAsSqlString = value
                        Else
                            GetValueAsSqlString = Format(value, "hh:mm:ss")
                        End If

                        Call Assert( _
                            StringIsSqlTime(GetValueAsSqlString), _
                            "Expected time as hh:mm:ss, but found " & GetValueAsSqlString, _
                            "GetValueAsSqlString" _
                        )
                    Case Else
                        err.Raise 5, "GetValueAsSqlString", _
                            "SqlType of " & GetSqlType(index_n) & " has not been configured for escaping"
                End Select

                GetValueAsSqlString = "'" & GetValueAsSqlString & "'"
        End Select
    End If
End Function

Dependency Module:

Function GetArrayLength(ByVal a As Variant) As Integer
    ' https://stackoverflow.com/a/30574874 '
    GetArrayLength = UBound(a) - LBound(a) + 1
End Function

Sub Assert( _
 ByVal b As Boolean, _
 ByVal msg As String, _
 Optional ByVal src As String = "Assert" _
 )
    If Not b Then
        err.Raise 5, src, msg
    End If
End Sub

Sub SetThisToThat(ByRef this As Variant, ByVal that As Variant)
    ' Used if "that" can be an object or a primitive '
    If IsObject(that) Then
        Set this = that
    Else
        this = that
    End If
End Sub

Function StringIsDigits(ByVal s As String) As Boolean
    StringIsDigits = Len(s) And (s Like String(Len(s), "#"))
End Function

Function StringIsInteger(ByVal s As String) As Boolean
    If Left$(s, 1) = "-" Then
        StringIsInteger = StringIsDigits(Mid$(s, 2))
    Else
        StringIsInteger = StringIsDigits(s)
    End If
End Function

Function StringIsFractional( _
 ByVal s As String, _
 Optional ByVal require_decimal As Boolean = False _
 ) As Boolean
    ' require_decimal means that the string must contain a "." decimal point '

    Dim n As Integer
    n = InStr(s, ".")

    If n Then
        StringIsFractional = StringIsInteger(Left$(s, n - 1)) And StringIsDigits(Mid$(s, n + 1))
    ElseIf require_decimal Then
        StringIsFractional = False
    Else
        StringIsFractional = StringIsInteger(s)
    End If
End Function

Function StringIsDate(ByVal s As String) As Boolean
    StringIsDate = True

    On Error GoTo no
        IsObject (DateValue(s))
    Exit Function
no:
    StringIsDate = False
End Function

Function StringIsSqlDate(ByVal s As String) As Boolean
    StringIsSqlDate = StringIsDate(s) And ( _
        (s Like "####-##-##") _
        Or (s Like "####-#-##") _
        Or (s Like "####-##-#") _
        Or (s Like "####-#-#") _
    )
End Function

Function StringIsTime(ByVal s As String) As Boolean
    StringIsTime = True

    On Error GoTo no
        IsObject (TimeValue(s))
    Exit Function
no:
    StringIsTime = False
End Function

Function StringIsSqlTime(ByVal s As String) As Boolean
    StringIsSqlTime = StringIsTime(s) And ( _
        (s Like "##:##:##") _
        Or (s Like "#:##:##") _
    )
End Function

Function StringIsDatetime(ByVal s As String) As Boolean
    Dim n As Integer
    n = InStr(s, " ")

    If n Then
        StringIsDatetime = StringIsDate(Left$(s, n - 1)) And StringIsTime(Mid$(s, n + 1))
    Else
        StringIsDatetime = False
    End If
End Function

Function StringIsSqlDatetime(ByVal s As String) As Boolean
    Dim n As Integer
    n = InStr(s, " ")

    If n Then
        StringIsSqlDatetime = StringIsSqlDate(Left$(s, n - 1)) And StringIsSqlTime(Mid$(s, n + 1))
    Else
        StringIsSqlDatetime = False
    End If
End Function

Example Usage:

Dim params As SqlParams
Set params = New SqlParams
params.Add SqlTypes.num_integer, 123

Dim sql As String
sql = "SELECT * FROM users WHERE id = " & params.SubstituteString

Dim odbc_str As String
odbc_str = "ODBC;DSN=my_dsn;"

Dim sheet As Worksheet
Set sheet = ThisWorkbook.Worksheets("Sheet1")

Dim table_name As String
table_name = "test_table"

Dim qt As QueryTable
Set qt = sheet.ListObjects.Add( _
    SourceType:=xlSrcExternal, _
    Source:=odbc_str, _
    Destination:=Range("$A$1") _
).QueryTable

With qt
    .ListObject.name = table_name
    .ListObject.DisplayName = table_name
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = False
End With

Call params.SetQueryTableSqlAndParams(qt, sql)
qt.Refresh BackgroundQuery:=False