Excel VBA QueryTable参数使用空值失败

Question

是否可以将JAVA_HOME值传递给NULL以便在（My）SQL查询中使用？

从this other answer，我们可以使用QueryTable.Parameters来做到这一点，但是不幸的是，ADODB.Command在Mac的Excel中不可用，我正在开发的应用程序应该在Windows和Mac上均可使用。

以下内容在Windows（我认为是Mac）上被确认为错误。

如果将ADODB设置为Null，则以下VBA代码可以正常工作，但是一旦尝试使用Null，它就会彻底失败。

param_value

---

将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 设置为“ hello”时，成功的结果如下：

（带有命令提示符屏幕截图的底部是MySQL的日志记录）。

---

这是将param_value设置为Null时的错误：

您可以从MySQL日志中看到，成功的查询首先执行param_value，然后是查询的Prepare。

失败的Null查询执行Execute，但从不执行Prepare。

在线搜索Execute没有帮助；人们报告说，从“冻结窗格”问题到“用户表单”问题，一切都得到了解决，而我对此一无所知，与run-time error -2147417848 (80010108)相关。

---

VBA代码不仅无法按预期工作，而且还会以某种方式破坏工作簿：

（在查询失败后尝试保存文件时会发生这种情况，请先关闭而不保存，然后您可以重新打开）。

---

MySQL日志显示VBA连接失败QueryTable，并且Excel文件损坏，这一事实使我认为不仅无法在Quit中使用Null，但这也是底层软件中的错误。

我是否缺少某些内容，还是不可能将Null参数传递给QueryTable？

更新

为回应亲密的投票：我的观点是，应该像引用here一样，将参数传递为QueryTable.Parameters。

更新

由于Null的问题，以及xlParamTypeDate没有从十进制转换为'yyyy-mm-dd'，我最终滚动了自己的参数化类模块。它已发布在下面，作为对该问题的解答。

Answer 1

如果有人知道如何使用QueryTable.Parameters完成此操作，请发布并选择答案。但是，以下是自定义解决方案。

对于除SqlTypes 以外的所有char ，参数化是自定义的，但是 char仍然使用QueryTable.Parameters，因为各种转义尝试实施该操作时可能会发生的极端情况。

编辑至以上删除线：实际上，我已恢复为也使用此自定义参数化手动处理char参数。我忘记了碰到的确切情况，但是得出的明确结论是，对于带有特定查询字符串的特定char参数的单个情况，VBA参数化失败了。我绝对不知道失败的原因在哪里。是在Microsoft的VBA方法的黑匣子中生成的，但我确认了这一事实，即对于这种看似随机的情况，字符串参数根本没有传递给（My）SQL引擎。可以说我的经验是，QueryTable.Parameters方法根本不能被完全信任。我的建议是取消注释GetValueAsSqlString = Replace$(Replace$(Replace$(CStr(value), "\", "\\"), "'", "\'"), """", "\""")的行，并删除IF char THEN中的SetQueryTableSqlAndParams逻辑。由于不同的引擎具有不同的literal characters，因此，我将其作为练习供读者在其情况下处理；例如，上面的Replace$()代码可能（或可能没有）具有包含\n的VBA字符串所希望的行为。

我注意到QueryTable的一个不一致之处是，如果执行SELECT "hello\r\nthere" AS s的非参数化查询，查询将以换行符返回（按预期），但是如果您使用QueryTable.Parameters xlParamTypeChar "hello\r\nthere"，则返回原始反斜杠。因此，在参数化string literals时必须使用vbCrLf等。

SqlParams类模块：

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

依赖模块：

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

示例用法：

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