在ADODB中执行具有十进制值的查询时，类型不匹配错误在ADODB.Parameter中键入adNumeric

Question

我需要将某些数据从SQL Server表复制到具有Excel VBA的类似Access表中。为此，我创建了一个函数，该函数根据Select语句创建将SQL插入到Access数据库（PreparedStatement）到SQL Server。

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

原始SQL Server源表字段中的数据类型为十进制（18,4），目标Access表中对应的类型为数字（十进制字段类型，精度为18，比例尺为4）。下面的代码看到字段类型adNumeric和NumericScale是4和精度是18.

例如，当我从源表中读取值5.16，并尝试将其插入到目标表中时，出现错误。如果我将读取值舍入为5，则插入无错误地工作。

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

我创建和执行基础上，选择查询的INSERT语句如下：

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

回答我自己的问题的尝试和错误小时后我找到了解决办法。

看来，我需要更改参数字段类型的情况下，来自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 2

我想这与小数的问题是，你用的是逗号，如Excel和小数点符号在Access中它是一个点。只需要检查这个假设是否正确，请执行以下操作：

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

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

编辑： 你可以这样做： replace(strValue,",",".")解决问题的地方，你通过十进制值？我认为它是在这里：

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

Answer 3

使用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