在 ADODB 中使用十进制值执行查询时出现类型不匹配错误。参数类型为 adNumeric

Question

我需要使用 Excel VBA 将 SQL Server 表中的一些数据复制到类似的 Access 表中。为此，我创建了一个函数，该函数根据 SQL Server 的 Select 语句创建将 SQL 插入 Access DB (PreparedStatement)。

字符串、日期和整数都很好。十进制值（adNumber 类型）如何导致错误“标准表达式中的数据类型不匹配”。如果我将十进制值四舍五入为整数，事情就会顺利进行。我还确认可以使用 access 手动将十进制值输入到目标表中。

原始 SQL Server 源表字段中的数据类型是小数（18,4），而在目标 Access 表中，相应的类型是数字（精度为 18 和小数位数为 4 的小数字段类型）。下面的代码将该字段视为 adNumeric 类型，NumericScale 为 4，Precision 为 18。

例如，当我从源表中读取值 5.16 并尝试将其插入目标表时，我得到一个错误。如果我将读取值四舍五入为 5，则插入工作不会出错。

那么我在这里做错了什么，我应该怎么做才能得到正确的十进制数字？

我正在根据 select 查询创建并执行插入语句，如下所示：

Private Sub AddToTargetDatabase(ByRef source As ADODB.Recordset, ByRef targetCn As ADODB.connection, tableName As String)
Dim flds As ADODB.Fields
Set flds = source.Fields
'target table is cleared at the beginning
targetCn.Execute ("DELETE FROM " & tableName)

Dim insertSQL As String
insertSQL = "INSERT INTO " & tableName & "("

Dim valuesPart As String
valuesPart = ") VALUES ("

Dim i As Integer

Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = targetCn
cmd.Prepared = True
Dim parameters() As ADODB.Parameter
ReDim parameters(flds.Count)

'Construct insert statement and parameters
For i = 0 To flds.Count - 1
    If (i > 0) Then
        insertSQL = insertSQL & ","
        valuesPart = valuesPart & ","
    End If
    insertSQL = insertSQL & "[" & flds(i).Name & "]"
    valuesPart = valuesPart & "?"
    Set parameters(i) = cmd.CreateParameter(flds(i).Name, flds(i).Type, adParamInput, flds(i).DefinedSize)
    parameters(i).NumericScale = flds(i).NumericScale
    parameters(i).Precision = flds(i).Precision
    parameters(i).size = flds(i).DefinedSize
    cmd.parameters.Append parameters(i)
Next i
insertSQL = insertSQL & valuesPart & ")"
Debug.Print insertSQL
cmd.CommandText = insertSQL

'String generated only for debug purposes
Dim params As String


Do Until source.EOF

    params = ""
    For i = 0 To flds.Count - 1
        Dim avalue As Variant


        If (parameters(i).Type = adNumeric) And Not IsNull(source.Fields(parameters(i).Name).Value) And parameters(i).Precision > 0 Then
            avalue = source.Fields(parameters(i).Name).Value
            'If rounded insert works quite nicely
            'avalue = Round(source.Fields(parameters(i).Name).Value)
        Else
            avalue = source.Fields(parameters(i).Name).Value
        End If

        'construct debug for the line
        params = params & parameters(i).Name & " (" & parameters(i).Type & "/" & parameters(i).Precision & "/" & source.Fields(parameters(i).Name).Precision & ") = " & avalue & "|"

        parameters(i).Value = avalue

    Next i
    'print debug line containing parameter info
    Debug.Print params
    'Not working with decimal values!!
    cmd.Execute
    source.MoveNext
Loop

End Sub

Answer 1

我想小数的问题是您在 Excel 中使用逗号作为小数符号，而在 Access 中它是一个点。只需检查此假设是否正确，请执行以下操作：

• 单击文件 > 选项。
• 在高级选项卡的编辑选项下，清除使用系统分隔符复选框。
• 在小数分隔符和千位中键入新的分隔符 分隔框。

然后再次运行它。如果它运行完美，那么这就是问题所在。

编辑： 你能做这样的事情： replace(strValue,",",".")解决问题的地方，你传十进制值在哪里？我想是这里：

`insertSQL = insertSQL & "[" & replace(flds(i).Name,",",".") & "]"`

Answer 2

使用 Str 将小数转换为字符串表示形式以进行连接。 Str 总是插入一个点作为小数分隔符。

或者使用我的功能：

' Converts a value of any type to its string representation.
' The function can be concatenated into an SQL expression as is
' without any delimiters or leading/trailing white-space.
'
' Examples:
'   SQL = "Select * From TableTest Where [Amount]>" & CSql(12.5) & "And [DueDate]<" & CSql(Date) & ""
'   SQL -> Select * From TableTest Where [Amount]> 12.5 And [DueDate]< #2016/01/30 00:00:00#
'
'   SQL = "Insert Into TableTest ( [Street] ) Values (" & CSql(" ") & ")"
'   SQL -> Insert Into TableTest ( [Street] ) Values ( Null )
'
' Trims text variables for leading/trailing Space and secures single quotes.
' Replaces zero length strings with Null.
' Formats date/time variables as safe string expressions.
' Uses Str to format decimal values to string expressions.
' Returns Null for values that cannot be expressed with a string expression.
'
' 2016-01-30. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function CSql( _
    ByVal Value As Variant) _
    As String

    Const vbLongLong    As Integer = 20
    Const SqlNull       As String = " Null"

    Dim Sql             As String
    Dim LongLong        As Integer

    #If Win32 Then
        LongLong = vbLongLong
    #End If
    #If Win64 Then
        LongLong = VBA.vbLongLong
    #End If

    Select Case VarType(Value)
        Case vbEmpty            '    0  Empty (uninitialized).
            Sql = SqlNull
        Case vbNull             '    1  Null (no valid data).
            Sql = SqlNull
        Case vbInteger          '    2  Integer.
            Sql = Str(Value)
        Case vbLong             '    3  Long integer.
            Sql = Str(Value)
        Case vbSingle           '    4  Single-precision floating-point number.
            Sql = Str(Value)
        Case vbDouble           '    5  Double-precision floating-point number.
            Sql = Str(Value)
        Case vbCurrency         '    6  Currency.
            Sql = Str(Value)
        Case vbDate             '    7  Date.
            Sql = Format(Value, " \#yyyy\/mm\/dd hh\:nn\:ss\#")
        Case vbString           '    8  String.
            Sql = Replace(Trim(Value), "'", "''")
            If Sql = "" Then
                Sql = SqlNull
            Else
                Sql = " '" & Sql & "'"
            End If
        Case vbObject           '    9  Object.
            Sql = SqlNull
        Case vbError            '   10  Error.
            Sql = SqlNull
        Case vbBoolean          '   11  Boolean.
            Sql = Str(Abs(Value))
        Case vbVariant          '   12  Variant (used only with arrays of variants).
            Sql = SqlNull
        Case vbDataObject       '   13  A data access object.
            Sql = SqlNull
        Case vbDecimal          '   14  Decimal.
            Sql = Str(Value)
        Case vbByte             '   17  Byte.
            Sql = Str(Value)
        Case LongLong           '   20  LongLong integer (Valid on 64-bit platforms only).
            Sql = Str(Value)
        Case vbUserDefinedType  '   36  Variants that contain user-defined types.
            Sql = SqlNull
        Case vbArray            ' 8192  Array.
            Sql = SqlNull
        Case Else               '       Should not happen.
            Sql = SqlNull
    End Select

    CSql = Sql & " "

End Function

Answer 3

经过数小时的反复试验，我找到了解决方案。

在 SQL Server 中的 Select 语句的类型为 adNumeric 且精度大于 0 的情况下，我似乎需要更改参数字段类型。将目标 Access DB 查询参数类型更改为 adDouble 而不是 adDecimal 或 adNumber 就可以了：

    Dim fieldType As Integer
    If (flds(i).Type = adNumeric And flds(i).Precision > 0) Then
        fieldType = adDouble
    Else
        fieldType = flds(i).Type
    End If
    Set parameters(i) = cmd.CreateParameter("@" & flds(i).Name, fieldType, adParamInput, flds(i).DefinedSize)

Answer 4

我处理过类似的情况，我按照这些步骤解决了。对不起我的英语不好，我会尽力做到最好:)

我创建了一个临时 excel 表，其中第一行包含所有列名称，如 sql 表。当主工作表中的主表使用=SI($B2="";"";MainSheet!$F15) 或=SI($B2="";"";TEXTO(Fecha;"YYYY-DD-MM HH:mm:ss.mss")) 等公式填充日期时间值时，此表中的数据会自动填充。如果是数字=SI($B2="";"";VALOR(DECIMAL(MainSheet!AB15;2)))

在那之后，我将@Gustav 附加到模块，几乎没有修改，从单元格的值中读取“NULL”以转义引号。

    ' Converts a value of any type to its string representation.
' The function can be concatenated into an SQL expression as is
' without any delimiters or leading/trailing white-space.
'
' Examples:
'   SQL = "Select * From TableTest Where [Amount]>" & CSql(12.5) & "And [DueDate]<" & CSql(Date) & ""
'   SQL -> Select * From TableTest Where [Amount]> 12.5 And [DueDate]< #2016/01/30 00:00:00#
'
'   SQL = "Insert Into TableTest ( [Street] ) Values (" & CSql(" ") & ")"
'   SQL -> Insert Into TableTest ( [Street] ) Values ( Null )
'
' Trims text variables for leading/trailing Space and secures single quotes.
' Replaces zero length strings with Null.
' Formats date/time variables as safe string expressions.
' Uses Str to format decimal values to string expressions.
' Returns Null for values that cannot be expressed with a string expression.
'
' 2016-01-30. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function CSql( _
    ByVal Value As Variant) _
    As String

    Const vbLongLong    As Integer = 20
    Const SqlNull       As String = " Null"

    Dim Sql             As String
    'Dim LongLong        As Integer

    #If Win32 Then
    '    LongLong = vbLongLong
    #End If
    #If Win64 Then
    '    LongLong = VBA.vbLongLong
    #End If

    Select Case VarType(Value)
        Case vbEmpty            '    0  Empty (uninitialized).
            Sql = SqlNull
        Case vbNull             '    1  Null (no valid data).
            Sql = SqlNull
        Case vbInteger          '    2  Integer.
            Sql = Str(Value)
        Case vbLong             '    3  Long integer.
            Sql = Str(Value)
        Case vbSingle           '    4  Single-precision floating-point number.
            Sql = Str(Value)
        Case vbDouble           '    5  Double-precision floating-point number.
            Sql = Str(Value)
        Case vbCurrency         '    6  Currency.
            Sql = Str(Value)
        Case vbDate             '    7  Date.
            Sql = Format(Value, " \#yyyy\/mm\/dd hh\:nn\:ss\#")
        Case vbString           '    8  String.
            Sql = Replace(Trim(Value), "'", "''")
            If Sql = "" Then
                Sql = SqlNull
            ElseIf Sql = "NULL" Then
                Sql = SqlNull
            Else
                Sql = " '" & Sql & "'"
            End If
        Case vbObject           '    9  Object.
            Sql = SqlNull
        Case vbError            '   10  Error.
            Sql = SqlNull
        Case vbBoolean          '   11  Boolean.
            Sql = Str(Abs(Value))
        Case vbVariant          '   12  Variant (used only with arrays of variants).
            Sql = SqlNull
        Case vbDataObject       '   13  A data access object.
            Sql = SqlNull
        Case vbDecimal          '   14  Decimal.
            Sql = Str(Value)
        Case vbByte             '   17  Byte.
            Sql = Str(Value)
        'Case LongLong           '   20  LongLong integer (Valid on 64-bit platforms only).
            Sql = Str(Value)
        Case vbUserDefinedType  '   36  Variants that contain user-defined types.
            Sql = SqlNull
        Case vbArray            ' 8192  Array.
            Sql = SqlNull
        Case Else               '       Should not happen.
            Sql = SqlNull
    End Select

    CSql = Sql & " "

End Function

然后我将Petrik's Code 代码附加到我的模块中。但稍作修改。

Function Insert2DB(InputRange As Range, Optional ColumnsNames As Variant, Optional TableName As Variant)

      Dim rangeCell As Range
      Dim InsertValues As String
      Dim CellValue As String
      Dim C As Range

        Dim AllColls As String
        Dim SingleCell As Range
        Dim TableColls As String

    InsertValues = ""

    'Start Loop
    For Each rangeCell In InputRange.Cells

        CellValue = CSql(rangeCell.Value)
        'Debug.Print CellValue

    If (Len(InsertValues) > 0) Then
        InsertValues = InsertValues & "," & CellValue
    Else
        InsertValues = CellValue
    End If

    Next rangeCell
    'END Loop

    If IsMissing(ColumnsNames) Then
        TableColls = ""
        Else

        For Each SingleCell In ColumnsNames.Cells
            If Len(AllColls) > 0 Then
                     AllColls = AllColls & "," & "[" & Trim(Replace(SingleCell.Value, Chr(160), "")) & "]"
            Else
                    AllColls = "[" & Trim(Replace(SingleCell.Value, Chr(160), "")) & "]"
            End If
        Next SingleCell
        TableColls = " (" & AllColls & ")"
    End If


    'If TableName is not set, then take the name of a sheet
    If IsMissing(TableName) = True Then
        TableName = ActiveSheet.Name
    Else
    TableName = TableName
    End If

    'Set the return value
        Insert2DB = "INSERT INTO " & TableName & TableColls & " VALUES (" & InsertValues & ") "

    End Function

CellValue = CSql(rangeCell.Value) 做到这一点

我在我的临时表中添加了最后一列 =SI(A2<>"";Insert2DB(A2:W2;$A$1:$W$1;"sql_table");"")

在我运行导出到 SQL 的宏中

With Sheets("tempSheet")



' Column where Insert2DB formula is

Excel_SQLQuery_Column = "X"

'Skip the header row
iRowNo = 2

'Loop until empty cell
Do Until .Cells(iRowNo, 1) = ""



    iRowAddr = Excel_SQLQuery_Column & iRowNo

    SQLstr = .Range(iRowAddr).Value

    Cn.Execute (SQLstr)

    iRowNo = iRowNo + 1

Loop

End With

这对我很有用。感谢@Gustav 和@Petrik 分享他的代码。