getting duplication error on primary key when trying to write new record on table with relationship

[klnlsu]

I use the following code to create a duplicate record in my order header table which has an autonumber field (OrderHeaderID) as the primary key:

' copy header record
Dim Con1 As New ADODB.Connection, Con2 As New ADODB.Connection
Set Con1 = CurrentProject.Connection
Set Con2 = CurrentProject.Connection
Dim rs1 As New ADODB.Recordset, rs2 As New ADODB.Recordset
rs1.Open "tblOEOrderHeader", Con1, adOpenDynamic, adLockPessimistic
rs2.Open "SELECT * FROM tblOEOrderHeader WHERE OrderHeaderID = " & OrderHeaderIDTxt, Con2, adOpenDynamic, adLockPessimistic
Dim F, FieldName As String
Dim HoldID As Long
rs1.AddNew
For Each F In rs2.Fields
FieldName = F.Name
If FieldName <> "OrderHeaderID" Then
If IsNull(rs1(FieldName)) And FieldName = "curr_cd" Then
rs1(FieldName) = ""
Else
rs1(FieldName).Value = rs2(FieldName).Value
End If
End If
Next
rs1("ord_no") = ""
rs1.Update
HoldID = rs1("OrderHeaderID")
rs1.Close: rs2.Close
Con1.Close: Con2.Close
Set rs1 = Nothing: Set rs2 = Nothing
Set Con1 = Nothing: Set Con2 = Nothing


... and it works fine. I try to use almost identical code on my order detail table which also has an autonumber field (OrderDetailID) as a primary key:

' copy detail record(s)
Dim Con3 As New ADODB.Connection, Con4 As New ADODB.Connection



Set Con3 = CurrentProject.Connection
Set Con4 = CurrentProject.Connection

Dim rs3 As New ADODB.Recordset, rs4 As New ADODB.Recordset

Set Con3 = CurrentProject.Connection
Set Con4 = CurrentProject.Connection

rs3.Open "tblOEOrderDetail", Con3, adOpenDynamic, adLockPessimistic
rs4.Open "SELECT * FROM tblOEOrderDetail WHERE OrderHeaderID = " & OrderHeaderIDTxt, Con4, adOpenDynamic, adLockPessimistic

While Not rs4.EOF
rs3.AddNew

For Each F In rs4.Fields

If FieldName <> "OrderDetailID" Then
FieldName = F.Name
rs3(FieldName).Value = rs4(FieldName).Value
End If

Next
rs3.Update
rs4.MoveNext
Wend
rs3.Close: rs4.Close
Con3.Close: Con4.Close
Set rs3 = Nothing: Set rs4 = Nothing
Set Con3 = Nothing: Set Con4 = Nothing

...and I get a duplication error because the "counter" for the autonumber field gets off and tries to create a record with a duplicate ID number. I have tried running the code on each table individually and get the same results. The order header table has a defined one-to-many relationship with the order detail table with referential integrity enforced. Could this be the problem? If so, is there a programmatic way to temporarily turn this relationship off before I run my code and turn it back on afterwards?

[CJ_London]

Your code is difficult to read. Please can you edit your post to include code tags which will preserve indentation.

[klnlsu]

I'm sorry. I guess I don't know what I am doing. Everytime I post it I lose my indentation.

[RuralGuy]

The "#" sign in the tool bar will create the code tags for you to put your code within.

[klnlsu]

The "#" sign in the tool bar will create the code tags for you to put your code within.

    ' copy header record
    Dim Con1 As New ADODB.Connection, Con2 As New ADODB.Connection
    Set Con1 = CurrentProject.Connection
    Set Con2 = CurrentProject.Connection
    Dim rs1 As New ADODB.Recordset, rs2 As New ADODB.Recordset
    rs1.Open "tblOEOrderHeader", Con1, adOpenDynamic, adLockPessimistic
    rs2.Open "SELECT * FROM tblOEOrderHeader WHERE OrderHeaderID = " & OrderHeaderIDTxt, Con2, adOpenDynamic, adLockPessimistic
    Dim F, FieldName As String
    Dim HoldID As Long
    rs1.AddNew
    For Each F In rs2.Fields
        FieldName = F.Name
        If FieldName <> "OrderHeaderID" Then
            If IsNull(rs1(FieldName)) And FieldName = "curr_cd" Then
                rs1(FieldName) = ""
            Else
                rs1(FieldName).Value = rs2(FieldName).Value
            End If
        End If
    Next
    rs1("ord_no") = ""
    rs1.Update
    HoldID = rs1("OrderHeaderID")
    rs1.Close: rs2.Close
    Con1.Close: Con2.Close
    Set rs1 = Nothing: Set rs2 = Nothing
    Set Con1 = Nothing: Set Con2 = Nothing
    ' copy detail record(s)
    Dim Con3 As New ADODB.Connection, Con4 As New ADODB.Connection
    
    Set Con3 = CurrentProject.Connection
    Set Con4 = CurrentProject.Connection
    
    Dim rs3 As New ADODB.Recordset, rs4 As New ADODB.Recordset
    
    Set Con3 = CurrentProject.Connection
    Set Con4 = CurrentProject.Connection
    
    rs3.Open "tblOEOrderDetail", Con3, adOpenDynamic, adLockPessimistic
    rs4.Open "SELECT * FROM tblOEOrderDetail WHERE OrderHeaderID = " & OrderHeaderIDTxt, Con4, adOpenDynamic, adLockPessimistic
    
    While Not rs4.EOF
        rs3.AddNew
        
        For Each F In rs4.Fields
        
            If FieldName <> "OrderDetailID" Then
                FieldName = F.Name
                rs3(FieldName).Value = rs4(FieldName).Value
            End If
            
        Next
        rs3.Update
        rs4.MoveNext
    Wend
    rs3.Close: rs4.Close
    Con3.Close: Con4.Close
    Set rs3 = Nothing: Set rs4 = Nothing
    Set Con3 = Nothing: Set Con4 = Nothing

[RuralGuy]

Success! Good job. I deleted the extra posts.

[klnlsu]

Thanks, Ruralguy!

[CJ_London]

Dim F, FieldName As String

your variable F is undefined so will be a variant

and in your code here, Fieldname is not defined for the row in red - well it is, whatever the last field in the rst2 recordset but I suspect that is not the intention

While Not rs4.EOF
        rs3.AddNew
        
        For Each F In rs4.Fields
        
            If FieldName <> "OrderDetailID" Then
                FieldName = F.Name
                rs3(FieldName).Value = rs4(FieldName).Value
            End If
            
        Next
        rs3.Update
        rs4.MoveNext
    Wend

If that is not the problem, please provide is simple English what the code is supposed to do

[RuralGuy]

You're very welcome. Just doing my job. Now we'll give Ajax a chance to solve your puzzle.

[davegri]

        For Each F In rs4.Fields
        
            If F.Name <> "OrderDetailID" Then
                FieldName = F.Name
                rs3(FieldName).Value = rs4(FieldName).Value
            End If

Should work.

[klnlsu]

Duh! I was looking for something complicated. Thanks.