How copy record from form header section and sub-form detail section

SteveL13
SteveL13 used Ask the Experts™
on
I'm trying to figure out how to copy a record from a main form's header section AND the sub-forms section with the exception of records in the sub-form section that have been marked as "Reject" (a check-box in the sub-form section).

Any help much appreciated.
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Distinguished Expert 2017

Commented:
You need two append queries.  One to copy the main form record.  The second to copy the subform record.  The first query uses as criteria just the primary key of the record to select, the second query will use the FK (which is the PK of the parent record) and also criteria that ignores  rejects.  This issue is that you need to obtain the PK of the copy of the parent record before you copy the child records so I would do the process using  a DAO recordset.
Dim db as DAO.Database
Dim rs as DAO.Recordset
Dim SavePK as Long
Dim strSQL as String

Set db = CurrentDB()
strSQL = "SELECT * From YourMainFormTable WHERE thePK = " & Me.thePK
set rs = td.OpenRecordset (strSQL, dbOpenDynaset, dbSeeChanges)
    rs.AddNew
        rs!fld1 = Me.fld1
        rs!fld2 = Me.fld2
        rs!fld3 = Me.fld3
        ...
        ...
        SavePK = rs!PK
    rs.Update

rs.Close
strSQL = "INSERT INTO yourSubformTable(FK, fld1, fld2, fld3) "
strSQL = strSQL & " SELECT " & SavePK & ", fld1, fld2, fld3 From yourSubformTable"
strSQL = strSQL & " WHERE FK = " & Me.thePK

db.Execute strSQL

Open in new window

Most Valuable Expert 2015
Distinguished Expert 2018

Commented:
As you already have the record and child records retrieved, there's no need to run queries to retrieve them once more.
Use the RecordsetClone which is extremely fast and requires no updates of the form(s):

Private Sub CopyButton_Click()

    Dim rst         As DAO.Recordset
    Dim rstAdd      As DAO.Recordset
    Dim fld         As DAO.Field
    Dim Count       As Integer
    Dim Item        As Integer
    Dim Bookmark    As Variant
    Dim NewId       As Long
    
    ' Copy parent record.
    Set rstAdd = Me.RecordsetClone
    Set rst = rstAdd.Clone
    
    ' Move to current record.
    rst.Bookmark = Me.Bookmark
    With rstAdd
        .AddNew
        For Each fld In .Fields
            With fld
                If .Attributes And dbAutoIncrField Then
                    ' Skip Autonumber or GUID field.
                Else
                    .Value = rst.Fields(.Name).Value
                End If
            End With
        Next
        .Update
        ' Pick Id of the new record.
        .MoveLast
        NewId = !Id.Value
    End With
    ' Store location of new record.
    Bookmark = rstAdd.Bookmark
    
    ' Copy child records.
    Set rstAdd = Me!subChild.Form.RecordsetClone
    Set rst = rstAdd.Clone

    Count = rstAdd.RecordCount
    For Item = 1 To Count
        With rstAdd
            .AddNew
            For Each fld In .Fields
                With fld
                    If .Attributes And dbAutoIncrField Then
                        ' Skip Autonumber or GUID field.
                    ElseIf .Name = "FK" Then     ' Adjust name of field holding the foreign key. 
                        ' Use the new foreign key.
                        .Value = NewId
                    ElseIf .Name = "Rejected" And rst.Fields(.Name).Value = True Then
                        ' Skip rejected record.
                    Else
                        .Value = rst.Fields(.Name).Value
                    End If
                End With
            Next
            .Update
        End With
        rst.MoveNext
    Next
    rst.Close
    rstAdd.Close
    
    ' Move to the new recordcopy.
    Me.Bookmark = Bookmark
    
    Set fld = Nothing
    Set rstAdd = Nothing
    Set rst = Nothing

End Sub

Open in new window

/gustav

Author

Commented:
Gustav, The code executes with minor changes I made to correct the real field name to "Reject" instead of "Rejected".   The header record is copied perfectly.  

But the child records are all copied, not just the one flagged as "Reject" and also they are all getting the PK value from the original header record instead of the new PK value.

Here is my altered code:

Private Sub cmdCopyRejectItemsToNewRecord_Click()

    Dim rst         As DAO.Recordset
    Dim rstAdd      As DAO.Recordset
    Dim fld         As DAO.Field
    Dim Count       As Integer
    Dim Item        As Integer
    Dim Bookmark    As Variant
    Dim NewId       As Long
    
    ' Copy parent record.
    Set rstAdd = Me.RecordsetClone
    Set rst = rstAdd.Clone
    
    ' Move to current record.
    rst.Bookmark = Me.Bookmark
    With rstAdd
        .AddNew
        For Each fld In .Fields
            With fld
                If .Attributes And dbAutoIncrField Then
                    ' Skip Autonumber or GUID field.
                Else
                    .Value = rst.Fields(.Name).Value
                End If
            End With
        Next
        .Update
        ' Pick Id of the new record.
        .MoveLast
        NewId = !LoadRecordID.Value
    End With
    ' Store location of new record.
    Bookmark = rstAdd.Bookmark
    
    ' Copy child records.
    Set rstAdd = Me!subfrmLoadDetail.Form.RecordsetClone
    Set rst = rstAdd.Clone

    Count = rstAdd.RecordCount
    For Item = 1 To Count
        With rstAdd
            .AddNew
            For Each fld In .Fields
                With fld
                    If .Attributes And dbAutoIncrField Then
                        ' Skip Autonumber or GUID field.
                    ElseIf .Name = "FK" Then     ' Adjust name of field holding the foreign key.
                        ' Use the new foreign key.
                        .Value = NewId
                    ElseIf .Name = "Reject" And rst.Fields(.Name).Value = True Then
                        ' Skip rejected record.
                    Else
                        .Value = rst.Fields(.Name).Value
                    End If
                End With
            Next
            .Update
        End With
        rst.MoveNext
    Next
    rst.Close
    rstAdd.Close
    
    ' Move to the new recordcopy.
    Me.Bookmark = Bookmark
    
    Set fld = Nothing
    Set rstAdd = Nothing
    Set rst = Nothing

End Sub

Open in new window

Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Most Valuable Expert 2015
Distinguished Expert 2018

Commented:
Yes, you need to completely skip the rejected records. Here is one method:

For Item = 1 To Count
    If rst!Reject.Value = False Then
        With rstAdd
            .AddNew
            For Each fld In .Fields
                With fld
                    If .Attributes And dbAutoIncrField Then
                        ' Skip Autonumber or GUID field.
                    ElseIf .Name = "FK" Then     ' Adjust name of field holding the foreign key.
                        ' Use the new foreign key.
                        .Value = NewId
                    Else
                        .Value = rst.Fields(.Name).Value
                    End If
                End With
            Next
            .Update
        End With
    End If
    rst.MoveNext
Next

Open in new window


As for the FK, I guess you forgot to adjust this line to hold your actual field name:

ElseIf .Name = "FK" Then     ' Adjust name of field holding the foreign key.

Open in new window

/gustav

Author

Commented:
Is still coping the child records that AREN'T flagged as "Reject" and is copying them with the original PK value.  I'm sure I'm missing something.   Should be copying the "Reject" record and assigning the PK as the new PK.  My code:

    Dim rst         As dao.Recordset
    Dim rstAdd      As dao.Recordset
    Dim fld         As dao.Field
    Dim Count       As Integer
    Dim Item        As Integer
    Dim Bookmark    As Variant
    Dim NewId       As Long
    
    ' Copy parent record.
    Set rstAdd = Me.RecordsetClone
    Set rst = rstAdd.Clone
    
    ' Move to current record.
    rst.Bookmark = Me.Bookmark
    With rstAdd
        .AddNew
        For Each fld In .Fields
            With fld
                If .Attributes And dbAutoIncrField Then
                    ' Skip Autonumber or GUID field.
                Else
                    .Value = rst.Fields(.Name).Value
                End If
            End With
        Next
        .Update
        ' Pick Id of the new record.
        .MoveLast
        NewId = !LoadRecordID.Value
    End With
    ' Store location of new record.
    Bookmark = rstAdd.Bookmark
    
    ' Copy child records.
    Set rstAdd = Me!subfrmLoadDetail.Form.RecordsetClone
    Set rst = rstAdd.Clone

    Count = rstAdd.RecordCount
    For Item = 1 To Count
        If rst!Reject.Value = False Then
            With rstAdd
                .AddNew
                For Each fld In .Fields
                    With fld
                        If .Attributes And dbAutoIncrField Then
                            ' Skip Autonumber or GUID field.
                        ElseIf .Name = "LoadsHeaderID" Then     ' Adjust name of field holding the foreign key.
                            ' Use the new foreign key.
                            .Value = NewId
                        Else
                            .Value = rst.Fields(.Name).Value
                        End If
                    End With
                Next
                .Update
            End With
        End If
        rst.MoveNext
    Next
    
    rst.Close
    rstAdd.Close
    
    ' Move to the new recordcopy.
    Me.Bookmark = Bookmark
    
    Set fld = Nothing
    Set rstAdd = Nothing
    Set rst = Nothing

Open in new window

Most Valuable Expert 2015
Distinguished Expert 2018

Commented:
First:
copy a record from a main form's header section AND the sub-forms section with the exception of records in the sub-form section that have been marked as "Reject"

Now:
Should be copying the "Reject" record

If so, change False to True.

Can't tell about the FK. Debug more carefully. The original code was tested successfully here.

/gustav

Author

Commented:
Changing to True worked.  And I found my error with the PK value.  But now, the copied child record has Reject as true because it was in the original but I need the copied record to be false.

??
Most Valuable Expert 2015
Distinguished Expert 2018

Commented:
Ah Steve, you should be a bit more creative ...

In my original code:

        ElseIf .Name = "Rejected" And rst.Fields(.Name).Value = True Then
            ' Skip rejected record.

Open in new window


Modify to:

        ElseIf .Name = "Reject" Then
            ' Always set to False.
            .Value = False

Open in new window

/gustav

Author

Commented:
I think my creativity has reach a breaking point.  Using the following code I am getting ALL child records copied and just want the one(s) flagged as "Reject" to be copied.  The good news is that the ones originally flagged as "Reject" are no longer flagged as "Reject" in the copies.

So, only thing left to do is NOT copy the ones not flagged as "Reject".

Sorry to be a pain.

    Dim rst         As DAO.Recordset
    Dim rstAdd      As DAO.Recordset
    Dim fld         As DAO.Field
    Dim Count       As Integer
    Dim Item        As Integer
    Dim Bookmark    As Variant
    Dim NewId       As Long
    
    ' Copy parent record.
    Set rstAdd = Me.RecordsetClone
    Set rst = rstAdd.Clone
    
    ' Move to current record.
    rst.Bookmark = Me.Bookmark
    With rstAdd
        .AddNew
        For Each fld In .Fields
            With fld
                If .Attributes And dbAutoIncrField Then
                    ' Skip Autonumber or GUID field.
                Else
                    .Value = rst.Fields(.Name).Value
                End If
            End With
        Next
        .Update
        ' Pick Id of the new record.
        .MoveLast
        NewId = !LoadRecordID.Value
    End With
    ' Store location of new record.
    Bookmark = rstAdd.Bookmark
    
    ' Copy child records.
    Set rstAdd = Me!subfrmLoadDetail.Form.RecordsetClone
    Set rst = rstAdd.Clone

    Count = rstAdd.RecordCount
    For Item = 1 To Count
        With rstAdd
            .AddNew
            For Each fld In .Fields
                With fld
                    If .Attributes And dbAutoIncrField Then
                        ' Skip Autonumber or GUID field.
                    ElseIf .Name = "LoadRecordID" Then     ' Adjust name of field holding the foreign key.
                        ' Use the new foreign key.
                        .Value = NewId
                    
                     ElseIf .Name = "Reject" Then
                    ' Always set to False.
                    .Value = False
                    ' Skip rejected record.
                    
                    Else
                        .Value = rst.Fields(.Name).Value
                    End If
                End With
            Next
            .Update
        End With
        rst.MoveNext
    Next
    rst.Close
    rstAdd.Close
    
    ' Move to the new recordcopy.
    Me.Bookmark = Bookmark
    
    Set fld = Nothing
    Set rstAdd = Nothing
    Set rst = Nothing

Open in new window

Most Valuable Expert 2015
Distinguished Expert 2018
Commented:
Great. The only thing missing is to skip those records:

    Count = rstAdd.RecordCount
    For Item = 1 To Count
        If rst!Reject.Value = True Then     ' <- this line
            With rstAdd
                .AddNew
                For Each fld In .Fields

                <snip>

                .Update
            End With
        End If                    ' <- this line
        rst.MoveNext
    Next        

Open in new window

/gustav

Author

Commented:
I thank you so much.  I now have a new challenge with this whole thing but am awarding the points for this one.  I'll be posting a new topic once I figure out how to word it.
Most Valuable Expert 2015
Distinguished Expert 2018

Commented:
You are welcome!

/gustav

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial