救命!将数据从一列复制到类似记录集中的同一列时出错

时间:2011-01-06 22:16:15

标签: vb6 copy adodb 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

非常直接。注意复制名称,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')。 ..当我解决了真正的问题时,我会稍后改变它。)

3 个答案:

答案 0 :(得分:1)

在打开像这样的合成记录集之前,您必须为PrecisionNumericScale字段设置adDecimaladNumeric

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个对象'PrecisionNumericScale属性。这是你的错误的重复,取消注释两行来修复错误:

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