Excel VBA QueryTable参数因空值而失败 [英] Excel VBA QueryTable Parameter Fails with Null Value

问题描述

是否可以将NULL值传递给QueryTable.Parameters以用于(My)SQL查询?

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

从其他答案，我们可以看到可以使用ADODB.Command来做到这一点，但不幸的是，ADODB在Mac版Excel中不可用，并且我正在开发的应用程序应该在Windows& Mac.

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.

以下内容在Windows(我认为是Mac)上被确认为错误.

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

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

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

---

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

---

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

(带有命令提示符屏幕截图的底部是MySQL的日志记录).

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

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

This is the error when setting param_value to Null:

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

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

失败的Null查询会执行Prepare，但决不会执行Execute.

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

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

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.

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

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).

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

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.

我是否缺少某些东西，还是不可能将Null参数传递给QueryTable?

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

对近距离投票的回应:我的观点是，应该有一种将参数传递为NULL的方法，就像在此处引用的那样.

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.

由于Null和

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.

推荐答案

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

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

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

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.

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

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.

我注意到QueryTable的一个不一致之处是，如果执行SELECT "hello\r\nthere" AS s的非参数化查询，该查询将以换行符返回(按预期)，但是如果您将QueryTable.Parameters xlParamTypeChar与"hello\r\nthere"一起使用，那么它将以原始反斜杠返回.因此，在参数化字符串文字时，必须使用vbCrLf等. .

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类模块:

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参数因空值而失败的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！