在 ADODB 中使用十进制值执行查询时键入不匹配错误.参数类型为广告数字

Question

我需要使用Excel VBA将一些数据从SQL Server表复制到类似的Access表中。为此，我创建了一个函数，该函数基于对SQL Server的选择语句创建插入SQL以访问DB(PreparedStatement)。

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

原始 SQL Server 源表字段中的数据类型为十进制 (18,4)，目标访问表中的相应类型为"数字"(精度为 18 且小数位数为 4 的十进制字段类型)。下面的代码将该字段视为 adNumeric 类型，NumericScale 为 4，精度为 18。

例如，当我从源表中读取值 5.16 并尝试将其插入目标表时，出现错误。如果我将读取值四舍五入为 5，则插入可以正常工作。

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

我正在基于选择查询创建和执行插入语句，如下所示：

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 的选择语句的类型为 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 的代码附加到我的模块中。但略有修改。

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分享他的代码。