主要形式的重复记录

Question

我在下面的问题上挣扎了我几个晚上的谷歌搜索这个问题，但我找到了一个代码，但是需要帮助

该问题是我需要以主形式，sub形式和“ subform”和“ subform”和“ subform”复制3个级别的3个级别，

我在下面的链接

https://www.pcreview.co.uk/threads/duplicate-data-data-in-form-isborm-isbormen-subform-and-subsubform.3483545/#post-14289062 ，

但不幸的是，这本帖子自2008年以来就不幸 想到它是从档案文件中的

无论如何都会 我在数据库中尝试此代码及其作品，用于主要形式和子形式的重复记录，但仅对“ usbubform”重复第一个记录

，并给出运行时错误如下： 运行时间错误3078： Microsoft Office访问数据库引擎找不到输入 表或查询。确保它存在并且名称是拼写的 正确。

我在VBA方面

知识

• 有限
• 的

非常 请找到以下代码

Private Sub cmdDuplicatePHIP_Click()
'Purpose: Duplicate the main form record and related records in the subform

Dim db As DAO.Database

Dim rstT2 As DAO.Recordset 'TRD_RDLog
Dim rstT2A As DAO.Recordset 'TRD_RDLog
Dim rstT3 As DAO.Recordset 'TFP_PHIPDtl
Dim rstT3A As DAO.Recordset 'TFP_PHIPDtl

Dim IngT1PK As Long ' current PK TRD_RDTrial
Dim IngT2PK As Long ' current PK TRD_RDLog
Dim IngT3PK As Long ' current PK TFP_PHIPDtl

Dim IngT1NewFK As Long ' new FK TRD_RDTrial
Dim IngT2NewFK As Long ' new FK TRD_RDLog
Dim IngT3NewFK As Long ' new FK TFP_PHIPDtl

Dim strSql As String 'SQL statement.
Dim strSql_S As String 'SQL statement.
Dim strSql_A As String 'SQL statement.
Dim msg As String

'records added
Dim intRC_CD As Integer 'TRD_RDTrial
Dim intRC_CS As Integer 'TRD_RDLog
Dim intRC_CA As Integer 'TFP_PHIPDtl

'Save and edits first
If Me.Dirty Then
Me.Dirty = False
End If

Set db = CurrentDb

'Make sure there is a record to duplicate.
If Me.NewRecord Then
MsgBox "Select the record to duplicate."
Else

'Duplicate the main record: add to form's clone.
'in TRD_RDTrial 1st table
IngT1PK = Me.TRPK

With Me.RecordsetClone
.AddNew
!TrialDate = Me.TrialDate
!TrialBy = Me.TrialBy
!QC = Me.QC
'etc for other fields.
.Update

intRC_CD = intRC_CD + 1

'Save the primary key value, to use as the foreign key for the related records.

.Bookmark = .LastModified
IngT1NewFK = !TRPK
End With

'Duplicate the related records in TRD_RDLog 2nd table
'Select all records in TRD_RDLog

strSql_S = " SELECT TDPK, TRPK, RDCode, Kitchen, TrialPurpose, PHIPNetWt, ItemTrialNotes, SampleApproval, SampleApprovalDate, SampleApprovalNotes, RecipeDate, Notes"
strSql_S = strSql_S & " FROM [TRD_RDLog];"
Set rstT2A = db.OpenRecordset(strSql_S)

'Select the records to duplicate
strSql_S = " SELECT TDPK, RDCode, Kitchen, TrialPurpose, PHIPNetWt, ItemTrialNotes, SampleApproval, SampleApprovalDate, SampleApprovalNotes, RecipeDate, Notes"
strSql_S = strSql_S & " FROM [TRD_RDLog]"
strSql_S = strSql_S & " WHERE TRPK = " & IngT1PK & ";"
Set rstT2 = db.OpenRecordset(strSql_S)

'check for empty recordset
If Not rstT2.BOF And Not rstT2.EOF Then
rstT2.MoveLast
rstT2.MoveFirst

Do While Not rstT2.EOF
'save PK
IngT2PK = rstT2!TDPK

'add new record
With rstT2A
.AddNew
!TRPK = IngT1NewFK
!RDCode = Nz(rstT2!RDCode, "")
!Kitchen = Nz(rstT2!Kitchen, "")
!TrialPurpose = Nz(rstT2!TrialPurpose, "")
!PHIPNetWt = Nz(rstT2!PHIPNetWt, "")
!ItemTrialNotes = Nz(rstT2!ItemTrialNotes, "")
!SampleApproval = Nz(rstT2!SampleApproval, "")
!SampleApprovalDate = Nz(rstT2!SampleApprovalDate, "")
!SampleApprovalNotes = Nz(rstT2!SampleApprovalNotes, "")
!RecipeDate = Nz(rstT2!RecipeDate, "")
!Notes = Nz(rstT2!Notes, "")

'etc for other fields.
.Update

intRC_CS = intRC_CS + 1

'get new PK
.Bookmark = .LastModified
IngT2NewFK = !TDPK ' new PK
End With


'Duplicate the related records in TFP_PHIPDtl (3rd table)

strSql_A = "SELECT IRF, TDPK, RawCode, Unit, PQty"
strSql_A = strSql_A & " FROM [TFP_PHIPDtl]"
Set rstT3A = db.OpenRecordset(strSql_A)
    
'Duplicate the related records in TFP_PHIPDtl (3rd table)

strSql_A = "SELECT IRF, RawCode, Unit, PQty"
strSql_A = strSql_A & " FROM [TFP_PHIPDtl]"
strSql_A = strSql_A & " WHERE TDPK = " & IngT2PK & ";"
Set rstT3 = db.OpenRecordset(strSql_A)

'check for empty recordset
If Not rstT3.BOF And Not rstT3.EOF Then
rstT3.MoveLast
rstT3.MoveFirst

Do While Not rstT3.EOF
'save PK
IngT3PK = rstT3!IRF

'add new record

With rstT3A
.AddNew
!TDPK = IngT2NewFK
!RawCode = Nz(rstT3!RawCode, "")
!Unit = Nz(rstT3!Unit, "")
!PQty = Nz(rstT3!PQty, "")
'etc for other fields.
.Update
intRC_CA = intRC_CA + 1

'Save the primary key value, to use as the foreign key for the related records.

.Bookmark = .LastModified
IngT3NewFK = !IRF
End With

'insert record
 
 db.Execute strSql, dbFailOnError


intRC_CA = intRC_CA + 1

rstT3.MoveNext
Loop
rstT3.Close
rstT3A.Close
End If
rstT2.MoveNext
Loop
rstT2.Close
rstT2A.Close
End If
End If

'Display the new duplicate.
 Me.FFP_PHIPLog.Visible = True
 Me.Label186.Visible = True
 Me.Label193.Visible = True
 Me.Label200.Visible = True
 Me.TrialDate.Locked = False
 Me.TrialBy.Locked = False
 Me.QC.Locked = False
 Me.TrialDate.Value = Null
 Me.TrialBy.Value = Null
 Me.QC.Value = Null

'tell me when done
msg = intRC_CD & " record added to TRD_RDTrial"
msg = msg & vbCrLf & vbCrLf
msg = msg & intRC_CS & " record(s) added to TRD_RDLOG"
msg = msg & vbCrLf & vbCrLf
msg = msg & intRC_CA & " record(s) added to TFP_PHIPDTL"
msg = msg & vbCrLf & vbCrLf
msg = msg & "Total records added = " & intRC_CD + intRC_CS + intRC_CA
MsgBox msg

End Sub

Answer 1

这是通过单击主表单上的按钮来实现此目的的完整代码。
当前的记录以及所有这些儿童记录和子记录都将在带有儿童和儿童记录的新的主要记录中复制，并且表格将显示以下：

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 rstAdd = Nothing
    Set rst = Nothing

End Sub

主要挑战是，尽管所有子记录都存在于子形式，只有一组子孙记录。因此，必须从SubChild表/查询中检索子孙记录，此处名为 tblchildChild 。

同样，主要的钥匙字段和外键字段分别命名为 id 和 fk 。根据需要进行调整。

复制一组儿童孩子记录：

Private Sub CopyButton_Click()

    Dim rst         As DAO.Recordset
    Dim rstAdd      As DAO.Recordset
    Dim fld         As DAO.Field
    Dim Bookmark    As Variant
    Dim Bookmark2   As Variant
    Dim Bookmark3   As Variant
    Dim NewId       As Long
    Dim NewSubId    As Long

    ' Record current bookmarks of child and subchild.
    Bookmark2 = Me!subChild.Form.Bookmark
    Bookmark3 = Me!subChild.Form!subChildChild.Form.Bookmark
    
    ' Copy parent record.
    Set rstAdd = Me.RecordsetClone
    Set rst = rstAdd.Clone

    ' Move to current parent 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 the new parent record.
    Bookmark = rstAdd.Bookmark
   
    ' Copy child record.
    Set rstAdd = Me!subChild.Form.RecordsetClone
    Set rst = rstAdd.Clone
    
    If rstAdd.RecordCount > 0 Then
        ' Move to current child record.
        rst.Bookmark = Bookmark2
        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

        ' Reposition child form.
        Me!subChild.Form.Bookmark = Bookmark2
        ' Copy child child record.
        Set rstAdd = Me!subChild.Form!subChildChild.Form.RecordsetClone
        Set rst = rstAdd.Clone

        If rstAdd.RecordCount > 0 Then
            ' Move to current child child record.
            rst.Bookmark = Bookmark3
            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 = NewSubId
                        Else
                            .Value = rst.Fields(.Name).Value
                        End If
                    End With
                Next
                .Update
            End With
        End If
    End If

    rst.Close
    rstAdd.Close

    ' Move to the new record copy.
    Me.Bookmark = Bookmark

    Set fld = Nothing
    Set rstAdd = Nothing
    Set rst = Nothing

End Sub

复制一组父子和所有孩子的记录：

Private Sub CopyButton_Click()

    Dim rst         As DAO.Recordset
    Dim rstAdd      As DAO.Recordset
    Dim fld         As DAO.Field
    Dim Bookmark    As Variant
    Dim Bookmark2   As Variant
    Dim Count       As Integer
    Dim Item        As Integer
    Dim NewId       As Long
    Dim NewSubId    As Long

    ' Record current bookmark of child.
    Bookmark2 = Me!subChild.Form.Bookmark
    
    ' Copy parent record.
    Set rstAdd = Me.RecordsetClone
    Set rst = rstAdd.Clone

    ' Move to current parent 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 the new parent record.
    Bookmark = rstAdd.Bookmark
   
    ' Copy child record.
    Set rstAdd = Me!subChild.Form.RecordsetClone
    Set rst = rstAdd.Clone
    
    If rstAdd.RecordCount > 0 Then
        ' Move to current child record.
        rst.Bookmark = Bookmark2
        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

        ' Reposition child form.
        Me!subChild.Form.Bookmark = Bookmark2
        ' Copy child child records.
        Set rstAdd = Me!subChild.Form!subChildChild.Form.RecordsetClone
        Set rst = rstAdd.Clone

        If rst.RecordCount > 0 Then
            rst.MoveLast
            rst.MoveFirst
        End If
        Count = rst.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 = NewSubId
                        Else
                            .Value = rst.Fields(.Name).Value
                        End If
                    End With
                Next
                .Update
            End With
            rst.MoveNext
        Next
    End If

    rst.Close
    rstAdd.Close

    ' Move to the new record copy.
    Me.Bookmark = Bookmark

    Set fld = Nothing
    Set rstAdd = Nothing
    Set rst = Nothing

End Sub