在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