Excel VBA QueryTable 参数因空值而失败

Question

是否可以将NULL值传递给QueryTable.Parameters以在 (My)SQL 查询中使用？

从另一个答案中，我们可以看到使用ADODB.Command可以做到这一点，但不幸的是， ADODB在 Excel for Mac 中不可用，我正在开发的应用程序应该可以在 Windows 和 Mac 上运行。

下面的内容被确认为 Windows 错误（我假设是 Mac）。

如果您将param_value设置为 Null 以外的任何值，以下 VBA 代码可以正常工作，但是一旦您尝试使用 Null，它就会失败。

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

将param_value设置为 "hello" 时，成功的结果如下所示：

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

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

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

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

在线搜索run-time error -2147417848 (80010108)无济于事； 人们报告说，从“冻结窗格”问题到“用户表单”问题的所有问题都得到了这一点，而我没有看到与QueryTable相关的任何内容。

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

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

MySQL 日志显示 VBA 连接失败Quit以及 Excel 文件损坏的事实使我认为不仅不可能在QueryTable.Parameters使用 Null ，而且它也是底层软件。

我是否遗漏了什么，或者不可能将空参数传递给 QueryTable？

更新

作为对投票结果的回应：我的观点是应该有一种方法可以将参数作为NULL传递，就像这里引用的一样。

更新

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

Answer 1

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

对于~~除char之外的~~所有SqlTypes ，参数化都是自定义的，但~~由于尝试实现它时可能发生的各种转义极端情况， char仍然使用QueryTable.Parameters~~ 。

编辑到上面的删除线：我实际上已经恢复为使用此自定义参数化手动处理字符参数。 我忘记了遇到的确切极端情况，但得出的最终结论是，对于具有特定查询字符串的特定字符参数的奇异情况，VBA 参数化失败了......我完全不知道故障点在哪里是在 Microsoft 的 VBA 方法的黑匣子中生成的，但我验证了一个事实确定性，即对于这个看似随机的情况，字符串参数根本没有传递给 (My)SQL 引擎。 我只想说，我的经验是，在QueryTable.Parameters方法根本无法在所有信任。 我的建议是取消注释GetValueAsSqlString = Replace$(Replace$(Replace$(CStr(value), "\\", "\\\\"), "'", "\\'"), """", "\\""")并删除SetQueryTableSqlAndParams中的IF char THEN逻辑。 由于不同的引擎有不同的字面量，我把它留作练习，让读者在他们的情况下处理； 例如，上面的Replace$()代码可能（也可能不）具有您希望使用包含\\n的 VBA 字符串看到的行为。

我注意到 QueryTable 的一个不一致之处是，如果您执行SELECT "hello\\r\\nthere" AS s的非参数化查询，查询将返回换行符（如预期），但如果您使用 QueryTable.Parameters xlParamTypeChar和"hello\\r\\nthere" ，然后它将返回原始反斜杠。 因此在参数化字符串文字时必须使用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

Excel VBA QueryTable 参数因空值而失败

问题描述

更新

更新

1 个解决方案

解决方案1
2 2018-10-09 05:57:45

Excel VBA QueryTable 参数因空值而失败

问题描述

更新

更新

1 个解决方案

解决方案1 2 2018-10-09 05:57:45

解决方案1
2 2018-10-09 05:57:45