Сбой параметра QueryTable в Excel VBA с нулевым значением

Question

Можно ли передать значение NULL в QueryTable.Parameters для использования в (My) SQL-запросе?

Из этого другого ответа , мы видим, что это возможночтобы сделать это с ADODB.Command, но, к сожалению, ADODB недоступно в Excel для Mac, и разрабатываемое мной приложение должно работать как на Windows, так и на Mac.

Ниже приведено подтверждение ошибки сWindows (и я предполагаю, что Mac).

Следующий код VBA работает нормально, если вы установите param_value для чего-либо, кроме Null, но как только вы попытаетесь использовать 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 на «привет» успешный результат выглядит следующим образом:

(Это нижнеечасть с снимком экрана командной строки - это то, что было записано в журнале MySQL).

---

Это ошибка при установке param_value в значение Null:

Из журнала MySQL видно, что сначала успешный запрос выполняет Prepare, а затем Execute запроса.

Принимая во внимание, что ошибочный запрос Null выполняет Prepare, но никогда не переходит на Execute.

Поиск в сети для run-time error -2147417848 (80010108) не поможет;люди сообщают о том, что получают все, от проблем «стоп-панели» до проблем «пользовательской формы», и я ничего не вижу по этому поводу, связанного с QueryTable.

---

Мало того, что код VBA не в состоянииработать должным образом, это также приводит к некоторому повреждению книги:

(это происходит при попытке сохранить файл после неудачного запроса; закрыть безсохранить и вы можете снова открыть).

---

Тот факт, что журнал MySQL показывает, что соединение VBA не удается Quit, и что файл Excel поврежден, заставляет меня думать, что это не тольконевозможно использовать Null в QueryTable.Parameters, но это также ошибка в базовом программном обеспечении.

Я что-то упустил или невозможно передать нулевой параметр в QueryTable?

Обновление

В ответ на закрытое голосование: я хочу сказать, что должен быть способ передать параметр как NULL, как указано здесь .

Обновление

Из-за этой проблемы с NuЧто касается того, что xlParamTypeDate не был преобразован из десятичного числа в «гггг-мм-дд», я закончил свой собственный модуль классов параметризации.Он был опубликован ниже в качестве ответа на этот вопрос.

Answer 1

Если кто-нибудь знает, как это сделать с помощью QueryTable.Parameters, то напишите, и я выберу ваш ответ.Но ниже приведено пользовательское решение.

Для всех SqlTypes , за исключением char, параметризация является пользовательской, но char по-прежнему использует QueryTable.Parameters из-за различныхизбегая угловых случаев, которые могут возникнуть при попытке реализовать это .

Правка зачеркнутого выше: я фактически вернулся к ручной обработке параметров char с этой пользовательской параметризацией.Я забыл точный случай, с которым столкнулся, но окончательный вывод был таковым: параметризация VBA не удалась для единичного случая конкретного параметра char с определенной строкой запроса ... Я абсолютно не знаю, где была точка отказабыл сгенерирован в «черном ящике» метода Microsoft VBA, но я подтвердил фактическую уверенность в том, что строковый параметр просто не передавался в (My) движок SQL для этого, казалось бы, случайного случая.Достаточно сказать, что мой опыт показывает, что методу QueryTable.Parameters просто нельзя доверять вообще .Я рекомендую раскомментировать строку GetValueAsSqlString = Replace$(Replace$(Replace$(CStr(value), "\", "\\"), "'", "\'"), """", "\""") и удалить логику IF char THEN в SetQueryTableSqlAndParams.Поскольку разные движки имеют разные буквенные символы , я оставляю это как упражнение для читателя, чтобы справиться с его обстоятельствами;например, приведенный выше код Replace$() может (или не может) иметь поведение, которое вы хотите видеть со строкой VBA, содержащей \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