我有一个例程,它读取一个记录集,并在类似的记录集中添加/更新行。该例程通过将列复制到新记录集开始:
以下是创建新记录集的代码..
For X = 1 To aRS.Fields.Count
mRS.Fields.Append aRS.Fields(X - 1).Name, aRS.Fields(X - 1).Type, aRS.Fields(X - _
1).DefinedSize, aRS.Fields(X - 1).Attributes
Next X
非常直接。注意复制名称,Type,DefinedSize&属性......
在代码中进一步向下,(并且没有任何东西可以修改...之间的任何列。)我正在将行的值复制到新记录集中的一行,如下所示:
For C = 1 To aRS.Fields.Count
mRS.Fields(C - 1) = aRS.Fields(C - 1)
Next C
当它到达最后一列是一个数字时,它会在“多个步骤操作生成错误”消息中扯断。
我知道MS说这是由提供商生成的错误,在这种情况下是ADO 2.8。此时也没有与DB的开放连接。
我正拉着我留下的那根头发......(此时我并不在意,一个回路中的列索引为'X',另一回路中的列为'C')。 ..当我解决了真正的问题时,我会稍后改变它。)
答案 0 :(得分:1)
在打开像这样的合成记录集之前,您必须为Precision
和NumericScale
字段设置adDecimal
和adNumeric
For X = 1 To aRS.Fields.Count
With aRS.Fields(X - 1)
Select Case .Type
Case adChar, adWChar, adBinary, _
adVarChar, adVarWChar, adVarBinary, _
adLongVarChar, adLongVarWChar, adLongVarBinary
mRS.Fields.Append .Name, .Type, .DefinedSize, .Attributes
Case adDecimal, adNumeric
mRS.Fields.Append .Name, .Type, , .Attributes
mRS.Fields(mRS.Fields.Count - 1).Precision = .Precision
mRS.Fields(mRS.Fields.Count - 1).NumericScale = .NumericScale
Case Else
mRS.Fields.Append .Name, .Type, , .Attributes
End Select
End With
Next
仅供参考:您可能会获得一个记录集,其中包含一个没有数据库名称的字段,例如
SELECT 5, 'No name'
但ADO不允许在Append
方法上使用空名称。您可能还会从数据库中获取包含重复字段的记录集,例如
SELECT 5 AS Col, 'Second' AS Col
在你的情况下也会在Append
上炸弹。
答案 1 :(得分:0)
猜猜2:正确的行应该是
mRS.Fields(C - 1).value = aRS.Fields(C - 1).value
我的猜测是你有一个null并且你没有正确处理dbnull类型。
答案 2 :(得分:0)
请参阅我关于寻找替代方法的评论,但直接的答案是需要设置Field
个对象'Precision
和NumericScale
属性。这是你的错误的重复,取消注释两行来修复错误:
Sub bfgosdb()
On Error Resume Next
Kill Environ$("temp") & "\DropMe.mdb"
On Error GoTo 0
Dim cat
Set cat = CreateObject("ADOX.Catalog")
With cat
.Create _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & _
Environ$("temp") & "\DropMe.mdb"
With .ActiveConnection
Dim Sql As String
Sql = _
"CREATE TABLE Test1 " & vbCr & "(" & vbCr & " col1 VARCHAR(255)," & _
" " & vbCr & " col2 INTEGER, " & vbCr & " col3 DECIMAL(19,4)" & vbCr & ");"
.Execute Sql
Sql = _
"INSERT INTO Test1 (col1, col2, col3) " & vbCr & "VALUES" & _
" (" & vbCr & "'128000 and some change', " & vbCr & "128000, " & vbCr & "128000.1234" & vbCr & ");"
.Execute Sql
Sql = _
"INSERT INTO Test1 (col1, col2, col3) " & vbCr & "VALUES" & _
" (" & vbCr & "NULL, " & vbCr & "NULL, " & vbCr & "NULL " & vbCr & ");"
.Execute Sql
Sql = _
"SELECT T11.col1, T11.col2, T11.col3 " & vbCr & " FROM" & _
" Test1 AS T11;"
Dim aRS
Set aRS = .Execute(Sql)
Dim mRS
Set mRS = CreateObject("ADODB.Recordset")
Dim X As Long
For X = 1 To aRS.Fields.Count
mRS.Fields.Append aRS.Fields(X - 1).Name, aRS.Fields(X - 1).Type, aRS.Fields(X - _
1).DefinedSize, aRS.Fields(X - 1).Attributes
' mRS.Fields(mRS.Fields.Count - 1).NumericScale = aRS.Fields(X - 1).NumericScale '
' mRS.Fields(mRS.Fields.Count - 1).Precision = aRS.Fields(X - 1).Precision '
Next X
mRS.Open
Do While Not aRS.EOF
mRS.AddNew
Dim C As Long
For C = 1 To aRS.Fields.Count
mRS.Fields(C - 1) = aRS.Fields(C - 1)
Next C
aRS.MoveNext
Loop
End With
Set .ActiveConnection = Nothing
End With
End Sub