帮助！将数据从一列复制到类似记录集中的同一列时出错

Question

我有一个例程，它读取一个记录集，并在类似的记录集中添加/更新行。该例程首先将列复制到新记录集：

这是创建新记录集的代码..

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

非常简单。注意名称、类型、定义大小和大小的复制。属性...

在代码的更下方，（并且没有任何内容可以修改之间的任何列..）我将一行的值复制到新记录集中的一行，如下所示：

 For C = 1 To aRS.Fields.Count
     mRS.Fields(C - 1) = aRS.Fields(C - 1)
 Next C

当它到达最后一列时这是一个数字，它会显示“多步操作生成错误”消息。

我知道 MS 说这是由提供程序生成的错误，在本例中为 ADO 2.8。此时也没有与数据库的开放连接。

我正在拉我剩下的一点头发......（此时我并不真正关心列索引在一个循环中是“X”而在另一个循环中是“C”......我当我解决真正的问题后会更改它......）

Answer 1

在打开合成记录集之前，您必须为 adDecimal 和 adNumeric 字段设置 Precision 和 NumericScale 仅供参考

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 上崩溃。

Answer 2

猜测 2：正确的行应该是

mRS.Fields(C - 1).value = aRS.Fields(C - 1).value

---

我的猜测是您有一个 null 并且您没有正确对待 dbnull 类型。

Answer 3

请参阅我关于寻找替代方法的评论，但直接的答案是需要设置 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