在 ADODB.Parameter 类型的 adNumeric 中使用十进制值执行查询时出现类型不匹配错误
Type Mismatch error when executing query with decimal value in ADODB.Parameter typed adNumeric
我需要将一些数据从 SQL 服务器 table 复制到具有 Excel VBA 的类似访问 table。为此，我创建了一个函数，它根据 SQL Server.SQL 语句创建 Insert SQL to Access DB (PreparedStatement)。
对于字符串、日期和整数，一切都很顺利。十进制值（adNumber 类型）如何导致错误 "Data type mismatch in criteria expression"。如果我将十进制值四舍五入为整数，事情就会顺利进行。我还确认我可以使用 access.
手动将十进制值输入目标 table
原始SQL服务器源table字段中的数据类型为decimal(18,4)，在目标Access table中对应的类型为Number（精度为18的Decimal字段类型和规模 4)。下面的代码将字段视为 adNumeric 类型，NumericScale 为 4，Precision 为 18。
例如，当我从源 table 读取值 5.16 并尝试将其插入到目标 table 时，出现错误。如果我将读取值四舍五入为 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
我想小数点的问题是您在 Excel 中使用逗号作为小数点符号，而在 Access 中它是一个点。只需检查此假设是否正确，请执行以下操作：
- 单击“文件”>“选项”。
- 在“高级”选项卡的“编辑选项”下，清除“使用系统分隔符”复选框。
- 在小数分隔符和千位中键入新的分隔符
分隔框。
然后运行再说一遍。如果它 运行 完美无缺，那就是问题所在。
编辑：
你能做这样的事情吗：
replace(strValue,",",".") 解决问题的地方，你在哪传十进制值？我认为它在这里：
`insertSQL = insertSQL & "[" & replace(flds(i).Name,",",".") & "]"`
使用 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
回答我自己的问题，因为经过数小时的反复试验，我找到了解决方案。
在 SQL 服务器的 Select 语句具有精度大于 0 的类型 adNumeric 的情况下，我似乎需要更改参数字段类型。更改目标 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)
我处理过类似的案例，我按照这个步骤解决了。抱歉我的英语不好，我会尽力而为:)
我创建了一个临时文件 excel sheet，所有列名都在第一行，如 sql table。当 main sheet 中的 main table 填充时，此 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) 表演一下
我在临时 sheet 中添加了最后一列 =SI(A2<>"";Insert2DB(A2:W2;$A:$W;"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 分享他的代码。
我需要将一些数据从 SQL 服务器 table 复制到具有 Excel VBA 的类似访问 table。为此，我创建了一个函数，它根据 SQL Server.SQL 语句创建 Insert SQL to Access DB (PreparedStatement)。
对于字符串、日期和整数，一切都很顺利。十进制值（adNumber 类型）如何导致错误 "Data type mismatch in criteria expression"。如果我将十进制值四舍五入为整数，事情就会顺利进行。我还确认我可以使用 access.
手动将十进制值输入目标 table原始SQL服务器源table字段中的数据类型为decimal(18,4)，在目标Access table中对应的类型为Number（精度为18的Decimal字段类型和规模 4)。下面的代码将字段视为 adNumeric 类型，NumericScale 为 4，Precision 为 18。
例如，当我从源 table 读取值 5.16 并尝试将其插入到目标 table 时，出现错误。如果我将读取值四舍五入为 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
我想小数点的问题是您在 Excel 中使用逗号作为小数点符号，而在 Access 中它是一个点。只需检查此假设是否正确，请执行以下操作：
- 单击“文件”>“选项”。
- 在“高级”选项卡的“编辑选项”下，清除“使用系统分隔符”复选框。
- 在小数分隔符和千位中键入新的分隔符 分隔框。
然后运行再说一遍。如果它 运行 完美无缺，那就是问题所在。
编辑：
你能做这样的事情吗：
replace(strValue,",",".") 解决问题的地方，你在哪传十进制值？我认为它在这里：
`insertSQL = insertSQL & "[" & replace(flds(i).Name,",",".") & "]"`
使用 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
回答我自己的问题，因为经过数小时的反复试验，我找到了解决方案。
在 SQL 服务器的 Select 语句具有精度大于 0 的类型 adNumeric 的情况下，我似乎需要更改参数字段类型。更改目标 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)
我处理过类似的案例，我按照这个步骤解决了。抱歉我的英语不好，我会尽力而为:)
我创建了一个临时文件 excel sheet，所有列名都在第一行，如 sql table。当 main sheet 中的 main table 填充时，此 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) 表演一下
我在临时 sheet 中添加了最后一列 =SI(A2<>"";Insert2DB(A2:W2;$A:$W;"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 分享他的代码。