Wizards Copy Record Code Failing

[NightZEN]

I am trying to use this code to copy the current record to a new one, but I get a message saying: "Some of the field names for the data you are trying to paste don't match the field names on the forms". But they do. I am stumped on this one... any body have a thought?

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70
                        DoCmd.DoMenuItem acFormBar, acEditMenu, 2, , acMenuVer70
                        DoCmd.DoMenuItem acFormBar, acEditMenu, 5, , acMenuVer70

 

[SeeThru]

How about a custom one....

strSQL = "SELECT Contacts.* FROM Contacts WHERE (Contacts.ContactID)=" & Forms!Contacts.ContactID
Forms!Contacts.Refresh 'save any changes

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSQL)

If rst.EOF Then 'if there is no current record
    MsgBox "There must be a current record to copy!", vbCritical, "Record Copy"
    GoTo End_Button2
End If

'initialise variables
a = 0
ReDim arFieldCopies(0 To rst.Fields.Count - 1)
'fill field data array
For Each fld In rst.Fields
        arFieldCopies(a) = fld.Value
Next fld

rst.AddNew 'now add same fields in same order
'initialise variables
a = 0
For Each fld In rst.Fields
    fld.Value = arFieldCopies(a)
    a=a+1
Next fld
rst.Update 'save record


'requery form, move to new record.
DoCmd.SelectObject acForm, "Contacts"
    DoCmd.ShowAllRecords

Forms!Contacts!ContactID.SetFocus
DoCmd.FindRecord NewContactID, acEntire, acSearchAll, , acCurrent

End_Button2:
rst.Close
dbs.Close

Bit crude, but works ok. I've actually got an array of fields NOT to copy, but I've removed that bit.

 

[NightZEN]

Thanks, that works nice (after a few tweeks):

count = count + 1
                        Dim strSql As String
                        
                        Me.Refresh 'save any changes
                        
                        strSql = "SELECT TblPreProdAudit.* " _
                            & "FROM TblPreProdAudit " _
                            & "WHERE (((TblPreProdAudit.Key) = " _
                            & Me.Key _
                            & "));"
                            
                        'Debug.Print strSql
                        Dim rst As New ADODB.Recordset
                        rst.Open strSql, CurrentProject.Connection, adOpenDynamic, adLockPessimistic

                        If rst.EOF Then 'if there is no current record
                            MsgBox "There must be a current record to copy!", vbCritical, "Record Copy"
                            GoTo End_Paste
                        End If

                        'initialise variables
                        Dim a As Integer
                        a = 0
                        ReDim arFieldCopies(0 To rst.Fields.count - 1)
                        'fill field data array
                        Dim fld As Object
                        For Each fld In rst.Fields
                            arFieldCopies(a) = fld.value
                            a = a + 1
                        Next fld
                        
                        rst.AddNew 'now add same fields in same order
                        'initialise variables
                        a = 0
                        
                        For Each fld In rst.Fields
                            If a > 0 Then
                                fld.value = arFieldCopies(a)
                            End If
                            a = a + 1
                        Next fld
                        rst.Update  'save record
                                               
End_Paste:
                        rst.Close