我需要将一些数据从SQL Server表复制到使用Excel VBA的类似Access表。为此，我创建了一个函数，该函数根据对SQL Server的Select语句创建插入SQL到Access DB（PreparedStatement）。
字符串，日期和整数都很顺利。十进制值（adNumber类型）如何导致错误＆＃34;标准表达式中的数据类型不匹配＆＃34;。如果我将小数值四舍五入为整数，那么事情就会顺利进行。我还确认我可以使用访问权限手动输入十进制值到目标表。
原始SQL Server源表字段中的数据类型为十进制（18,4），在目标Access表中，相应的类型为Number（精度为18且比例为4的十进制字段类型）。下面的代码将字段视为adNumeric类型，NumericScale为4，Precision为18.
例如，当我从源表读取值5.16并尝试将其插入目标表时，我收到错误。如果我将读取值舍入为5，则插入操作没有错误。
那我在这里做错了什么，我该怎么办才能得到十进制数？
我根据select查询创建并执行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
答案 0 :(得分：0)
我认为小数点的问题在于您在Excel中使用逗号作为小数符号，而在Access中它是一个点。只需检查此假设是否正确，请执行以下操作：
然后再次运行它。如果它运行完美，那就是问题所在。
编辑：
你能做这样的事吗：
replace(strValue,",",".")解决问题的地方，你传递小数值？我想它就在这里：
`insertSQL = insertSQL & "[" & replace(flds(i).Name,",",".") & "]"`
答案 1 :(得分：0)
使用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
答案 2 :(得分：0)
在经过数小时的反复试验后，我回答了自己的问题，我找到了解决方案。
在SQL Server的Select语句具有精度大于0的类型adNumeric的情况下，似乎需要更改参数字段类型。将目标Access数据库查询参数类型更改为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)
答案 3 :(得分：0)
我已经处理过类似的案件，并且按照以下步骤解决了。对不起，我的英语不好，我会努力做到最好的：）
我已经创建了一个临时excel工作表，其中所有列名称（例如sql table）都位于第一行。如果使用日期时间值，使用=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分享他的代码。