excel vba querytable参数失败，值为空

能通过考试吗 NULL 价值 QueryTable.Parameters 用于（我的）sql查询？
从另一个答案，我们可以看出，这是可能的 ADODB.Command ，但不幸的是， ADODB 在excel for mac中不可用，我正在开发的应用程序应该可以同时在windows和mac上运行。
下面的内容被确认为windows的错误（我假设是mac）。
如果设置 param_value 但一旦你尝试使用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 设置为空：

您可以从mysql日志中看到，成功的查询首先执行 Prepare ，然后是 Execute 查询的名称。
而失败的null查询执行 Prepare ，但从未到达终点 Execute .
在线搜索 run-time error -2147417848 (80010108) 无济于事；从“冻结窗格”问题到“用户窗体”问题，人们都在报告这一点，我看不到任何与此相关的信息 QueryTable .
vba代码不仅无法按预期工作，还会以某种方式损坏工作簿：

（在查询失败后尝试保存文件时发生这种情况；关闭而不保存，您可以重新打开）。
mysql日志显示vba连接失败 Quit ，并且excel文件被破坏了，这让我觉得在 QueryTable.Parameters ，但这也是底层软件中的一个bug。
我遗漏了什么，还是无法将空参数传递给查询表？

更新

作为对接近投票的回应：我的观点是，应该有一种方法将参数作为 NULL ，正如这里引用的。

更新

由于null的问题，以及xlparamtypedate没有从十进制转换为'yyyy-mm-dd'，我最终滚动了自己的参数化类模块。下面已经贴出了这个问题的答案。

如果有人知道如何用 QueryTable.Parameters ，然后发帖，我会选择你的答案。但下面是一个定制的解决方案。
对所有人 SqlTypes 除外 char ，参数化是自定义的，但是 char 仍然使用 QueryTable.Parameters 因为在尝试实现时可能会出现各种逃逸的情况。
编辑到上面的删除线：我实际上已经恢复到用这个自定义参数化手动处理char参数。我忘记了遇到的确切的角落案例，但得出的最终结论是vba参数化对于具有特定查询字符串的特定char param的单一案例是失败的。。。我完全不知道失败点在哪里，因为它是在microsoft的vba方法的黑盒中生成的，但是我确认了一个事实，即字符串param根本没有被传递到（我的）sql引擎，因为它看起来是随机的。我的经验是 QueryTable.Parameters 方法根本不可信。我的建议是取消注解 GetValueAsSqlString = Replace$(Replace$(Replace$(CStr(value), "\", "\\"), "'", "\'"), """", "\""") 并移除 IF char THEN 内部逻辑 SetQueryTableSqlAndParams . 由于不同的引擎有不同的文字字符，我把这作为一个练习留给读者在他们的环境中处理；例如，上述 Replace$() 代码可能具有（也可能不具有）您希望在包含 \n .
我注意到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条答案

相关问题

热门标签

最新问答