[AccessD] DAO rules

Rocky Smolin rockysmolin2 at gmail.com
Wed Feb 17 11:47:45 CST 2021


Very cool. I've always preferred DAO to trying to figure out how to force a
query to do something like this.

r

On Wed, Feb 17, 2021 at 8:21 AM Gustav Brock via AccessD <
accessd at databaseadvisors.com> wrote:

> Hi all
>
> I have often promoted DAO rather than lengthy and custom append queries,
> as the tool to copy a parent record and its child records.
> This, I had the chance to expand to also copy subchild records (or
> grandchildren records if you like) of the child records.
>
> The clever part is, that - apart from the key fields, the subform control
> name, and the subchild table/query name - specifics like field names are
> not used:
>
>
> https://www.experts-exchange.com/questions/29208270/MS-Access-Duplicate-Records-with-Multi-Levels-of-Subforms.html#a43244285
>
> If you can't open the link, code is here:
>
> Private Sub CopyButton_Click()
>
>     Dim rst         As DAO.Recordset
>     Dim rstAdd      As DAO.Recordset
>     Dim rstSub      As DAO.Recordset
>     Dim rstSubAdd   As DAO.Recordset
>     Dim fld         As DAO.Field
>     Dim Count       As Integer
>     Dim CountSub    As Integer
>     Dim Item        As Integer
>     Dim ItemSub     As Integer
>     Dim Bookmark    As Variant
>     Dim OldId       As Long
>     Dim NewId       As Long
>     Dim NewSubId    As Long
>
>     ' Copy parent record.
>     Set rstAdd = Me.RecordsetClone
>     Set rst = rstAdd.Clone
>
>     ' Move to current record.
>     rst.Bookmark = Me.Bookmark
>     OldId = rst!Id.Value
>     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.
>     ' If a subform is present:
>     Set rstAdd = Me!subChild.Form.RecordsetClone
>     ' If a subform is not present, retrieve records from the child table:
> '    Set rstAdd = CurrentDb.OpenRecordset("Select * From tblChild Where FK
> = " & OldId & "")
>     Set rst = rstAdd.Clone
>
>     If rstAdd.RecordCount > 0 Then
>         rstAdd.MoveLast
>         rstAdd.MoveFirst
>     End If
>     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
>                         ' Skip master/child field.
>                         .Value = NewId
>                     Else
>                         .Value = rst.Fields(.Name).Value
>                     End If
>                 End With
>             Next
>             .Update
>             ' Pick Id of the new record.
>             .MoveLast
>             NewSubId = !Id.Value
>         End With
>
>         ' Copy childchild records.
>         Set rstSubAdd = CurrentDb.OpenRecordset("Select * From
> tblChildChild Where FK = " & rst!Id.Value & "")
>         Set rstSub = rstSubAdd.Clone
>
>         If rstSubAdd.RecordCount > 0 Then
>             rstSubAdd.MoveLast
>             rstSubAdd.MoveFirst
>         End If
>         CountSub = rstSubAdd.RecordCount
>         For ItemSub = 1 To CountSub
>             With rstSubAdd
>                 .AddNew
>                 For Each fld In .Fields
>                     With fld
>                         If .Attributes And dbAutoIncrField Then
>                             ' Skip Autonumber or GUID field.
>                         ElseIf .Name = "FK" Then
>                             ' Skip master/child field.
>                             .Value = NewSubId
>                         Else
>                             .Value = rstSub.Fields(.Name).Value
>                         End If
>                     End With
>                 Next
>                 .Update
>             End With
>             rstSub.MoveNext
>         Next
>
>         rst.MoveNext
>     Next
>     rstSub.Close
>     rstSubAdd.Close
>     rst.Close
>     rstAdd.Close
>
>     ' Move to the new recordcopy.
>     Me.Bookmark = Bookmark
>
>     Set fld = Nothing
>     Set rstSubAdd = Nothing
>     Set rstSub = Nothing
>     Set rstAdd = Nothing
>     Set rst = Nothing
>
> End Sub
>
> /gustav
>
> --
> AccessD mailing list
> AccessD at databaseadvisors.com
> https://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>


More information about the AccessD mailing list