0

我正在尝试使用 VBA 代码在主窗体和子窗体中复制记录。主窗体的记录源"FMainForm"是"tbl_Main_Data_Sheet"有 6 个字段，如(ID, Date, News, Update, Customer_Name, Employee_Name). 这"ID"是带有自动编号的主键。子表单的记录源"FTeam"也"tbl_Team"有六个字段，如(TMID, Shop_Name, Staff_Name, Staff_Mood, Presence, RefID)。这"TMID"是带有自动编号的主键，并RefID与"ID"of链接"tbl_Main_Data_Sheet"。

我想创建一个复制按钮，它将复制当前记录并将其粘贴为主表单和子表单中的多个记录中的新记录。我从网站上获得了以下代码并应用它。它仅适用于主窗体，但不适用于子窗体。任何人都可以帮我解决它。我是 VBA 的新手。

Private Sub Command113_Click()
'On Error GoTo Err_Handler
    'Purpose:   Duplicate the main form record and related records in the subform.
    Dim strSQL As String    'SQL statement.
    Dim lngID As Long       'Primary key value of the new record.
    
    'Save any edits first
    If Me.Dirty Then
        Me.Dirty = False
    End If
    
    '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.
        With Me.RecordsetClone
            .AddNew
                !Employee_Name = Me.Employee_Name
                !Date = Me.Date
                !Customer_Name = Me.Customer_Name
                !News = Me. News
                !Update = Me.Update
                
                'etc for other fields.
            .Update
            
            'Save the primary key value, to use as the foreign key for the related records.
            .Bookmark = .LastModified
            lngID = !ID
            
            'Duplicate the related records: append query.
            
            If Me.Child119.Form.RecordsetClone.RecordCount > 0 Then
            
                strSQL = "INSERT INTO [tbl_Team] ( TMID, Shop_Name, Staff_Name, Staff_Mood, Presence, RefID ) " & _
                    "SELECT " & lngID & " As NewTMID, Shop_Point, Staff_Name, Staff_Mood, Presence, RefID " & _
                    "FROM [tbl_Team] WHERE RefID = " & Me.ID & ";"
                    DBEngine(0)(0).Execute strSQL, dbFailOnError
                    
                     
                     
            Else
                MsgBox "Main record duplicated, but there were no related records."
            End If
            
            'Display the new duplicate.
            Me.Bookmark = .LastModified
        End With
    End If

Exit_Handler:
    Exit Sub

Err_Handler:
    MsgBox "Error " & Err.Number & " - " & Err.Description, , "cmdDupe_Click"
    Resume Exit_Handler

End Sub
4

0 回答 0