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

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.
SteveL13Asked:
Who is Participating?
 
Gustav BrockConnect With a Mentor CIOCommented:
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
0
 
PatHartmanCommented:
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

0
 
Gustav BrockCIOCommented:
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
0
Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
SteveL13Author 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

0
 
Gustav BrockCIOCommented:
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
0
 
SteveL13Author 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

0
 
Gustav BrockCIOCommented:
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
0
 
SteveL13Author 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.

??
0
 
Gustav BrockCIOCommented:
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
0
 
SteveL13Author 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

0
 
SteveL13Author 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.
0
 
Gustav BrockCIOCommented:
You are welcome!

/gustav
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.