CODEWITHSUNDEEP
vbams-access
AdverseYawn
AdverseYawn

Reputation: 23

Duplicate Record with New Primary Key (VBA)

I have a very large record that I'm trying to duplicate, then open a form with the new version with a new primary key ID. Can this be done in Access VBA without having to iterate through all the fields to copy the data?

Thanks!

Upvotes: 1

Views: 16009

Answers (3)

user13436426
user13436426

Reputation: 1

The procedure below uses an array to temporarily store the fields of a record and then copies those fields, except for the Primary Key, into a new record. For this to work only the Primary Key field can have an index set to No Duplicates.

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

Upvotes: 0

Gustav
Gustav

Reputation: 55831

The fastest and simplest way is to use DAO and the RecordsetClone of the form:

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

This moves the form from the current record to the new record. You can easily modify that to pick the new ID and open the other form with the new record.

Upvotes: 4

Brad
Brad

Reputation: 12255

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

enter image description here

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.

Upvotes: 3

Related Questions