Question

我有一个非常大的记录，我正在尝试复制，然后打开一个带有新主键ID的新版本的表单。这可以在Access VBA中完成，而无需遍历所有字段来复制数据吗？

谢谢！

Answer 1

最快最简单的方法是使用表格中的DAO和 RecordsetClone ：

Private Sub cmdDuplicate_Click()

  Dim rstSource   As DAO.Recordset
  Dim rstInsert   As DAO.Recordset
  Dim fld         As DAO.Field

  If Me.NewRecord = True Then Exit Sub

  Set rstInsert = Me.RecordsetClone
  Set rstSource = rstInsert.Clone
  With rstSource
    If .RecordCount > 0 Then
      ' Go to the current record.
      .Bookmark = Me.Bookmark
      With rstInsert
        .AddNew
          For Each fld In rstSource.Fields
            With fld
              If .Attributes And dbAutoIncrField Then
                ' Skip Autonumber or GUID field.
              ElseIf .Name = "SomeFieldToPreset" Then
                rstInsert.Fields(.Name).Value = SomeValue
              ElseIf .Name = "SomeFieldToExclude" Then
                ' Leave blank
              Else
                ' All other fields.
                ' Copy field content.
                rstInsert.Fields(.Name).Value = .Value
              End If
            End With
          Next
        .Update
        ' Go to the new record and sync form.
        .MoveLast
        Me.Bookmark = .Bookmark
        .Close
      End With
    End If
    .Close
  End With

  Set rstInsert = Nothing
  Set rstSource = Nothing

End Sub

这会将表单从当前记录移动到新记录。您可以轻松修改它以选择新ID并使用新记录打开另一个表单。

Answer 2

Look at the Duplicate Recordcommand. You can either use it as it comes out of the box

or investigate the code that is generated by the wizard and customize for yourself. The method with the wizard will not copy AutoNumber PKs if that is how your PK is set up.

Answer 3

以下过程使用数组临时存储记录的字段，然后将除主键之外的那些字段复制到新记录中。为此，只有“主键”字段可以将索引设置为“无重复”。

Sub MoveCustomer()
On Error GoTo Err_MoveCustomer

    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim myTable As TableDef
    Dim varCustID As Variant
    Dim Arr() As Variant
    Dim intCount As Integer
    Dim intI As Integer
    Dim strMsg As String

    Set dbs = CurrentDb
    Set myTable = dbs.TableDefs("tblCustomers")
    Set rst = dbs.OpenRecordset("tblCustomers", dbOpenDynaset)

    intCount = myTable.Fields.Count

    ReDim Arr(intCount)

    'ID field is Primary Key rst(0)
    rst.FindFirst "[ID] = 5"

    If rst.NoMatch = False Then
        'Record Found
        intI = 0

        'Temp store Cust Record in Array
        Do Until intI = intCount
            Arr(intI) = rst(intI)
            Debug.Print "Field " & intI & " = " & rst(intI)
            intI = intI + 1
        Loop

        'Copy Array contents into new record
        rst.AddNew

        intI = 0

        Do Until intI = intCount
            'Field 0 is Primary Key, do not copy
            If intI > 0 Then
                rst(intI) = Arr(intI)
            End If

            intI = intI + 1
        Loop

        rst.Update

        rst.Bookmark = rst.LastModified
        varCustID = rst![ID]

        rst.Close
        Set rst = Nothing
        Set dbs = Nothing

        'Additional Code as needed based on varCustID

    Else
        'No Record found
        strMsg = "The specified record was not found."
        MsgBox strMsg, vbInformation, "Aspire - Record not found"

    End If

Exit_MoveCustomer:
    Exit Sub
Err_MoveCustomer:
    strMsg = "The procedure to copy a record into a new record failed."
    MsgBox strMsg, vbInformation, "Aspire - Copy procedure failed."
    Resume Exit_MoveCustomer
End Sub

使用新主键（VBA）重复记录

3 个答案: