Help! Getting an error copying the data from one column to the same column in a similar recordset

I have a routine which reads one recordset, and adds/updates rows in a similar recordset. The routine starts off by copying the columns to a new recordset:

Here's the code for creating the new recordset..

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

Pretty straight forward. Notice the copying of the name, Type, DefinedSize & Attributes...

Further down in the code, (and there's nothing that modifies any of the columns between.. ) I'm copying the values of a row to a row in the new recordset as such:

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

When it gets to the last column which is a numeric, it craps with the "Mutliple-Step Operation Generated an error" message.

I know that MS says this is an err开发者_开发百科or generated by the provider, which in this case is ADO 2.8. There is no open connect to the DB at this point in time either.

I'm pulling what little hair I have left over this one... (and I don't really care at this point that the column index is 'X' in one loop & 'C' in the other... I'll change it later when I get the real problem fixed...)

You have to set Precision and NumericScale for adDecimal and adNumeric fields before opening synthetic recordset like this

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

FYI: you might be get a recordset with a field that has no name from the database e.g.

SELECT 5, 'No name'

but ADO will not allow an empty name on Append method. You might also get a recordset with duplicate fields from the database e.g.

SELECT 5 AS Col, 'Second' AS Col

which in your case will bomb out on Append too.

Guess 2 : the correct line should be

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

My guess is you have have a null and you are not treating the dbnull type right.

Please see my comments about finding an alternative approach but the straight answer is the Field objects' Precision and NumericScale properties need to be set. Here's a repro of your error, uncomment the two lines to fix the error:

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