子窗体中的记录重复到新记录

时间:2016-06-03 15:07:53

标签: ms-access access-vba

我在制造过程[Shedmodels]中有一个用于装配的表格。这些组件列在单独的表[ShedModelsComponents]中。 [ShedModels]中的主键是[ModelNumber][ShedModelsComponents]中的字段也称为[ModelNumber]。因此,每个组件都分配给表[ShedModels]中的某个组件。接下来,我为[ShedModels]创建了一个表单,其中嵌入了[ShedModelsComponents]的子表单。装配的所有组件看起来都像我想要的那样。到现在为止还挺好。现在我的许多程序集都使用了几乎相同的组件,因此我想将一个程序集中的所有组件复制或附加到[Shed Models]中的新记录中。我在MS网站上找到了这段代码。

Private Sub btnDuplicate_Click()
Dim dbs As DAO.Database, Rst As DAO.Recordset
Dim F As Form

' Return Database variable pointing to current database.
Set dbs = CurrentDb
Set Rst = Me.RecordsetClone

On Error GoTo Err_btnDuplicate_Click

' Tag property to be used later by the append query.
Me.Tag = Me![ModelNumber]

' Add new record to end of Recordset object.
With Rst
   .AddNew
      !ModelNumber = Me!ModelNumber
      !ModelDesc = Me!ModelDesc
      !ModelSalePrice = Me!ModelSalePrice
   .Update                     ' Save changes.
   .Move 0, .LastModified
End With
Me.Bookmark = Rst.Bookmark

' Run the Duplicate Order Details append query which selects all
' detail records that have the OrderID stored in the form's
' Tag property and appends them back to the detail table with
' the OrderID of the duplicated main form record.

DoCmd.SetWarnings False
DoCmd.OpenQuery "Duplicate Shed Models Components"
DoCmd.SetWarnings True

'Requery the subform to display the newly appended records.
Me![Shed_Models_Query].Requery

Exit_btnduplicate_Click:
Exit Sub

Err_btnDuplicate_Click:
MsgBox Error$
Resume Exit_btnduplicate_Click:

End Sub

但它会返回错误,这会产生重复的型号,我不会怀疑。如何将包含所有组件的程序集复制到新记录中,但更改型号(用户输入的那个)?

1 个答案:

答案 0 :(得分:0)

首先,复制父记录(就像你一样)。但是不要让表格转移到新记录。

接下来,获取新的PK。

然后,使用新PK复制子记录。这是一个骨架 - 您将使用子窗体的RecordsetClone。见下文。

最后,将父表单移动到新记录。子表单将自动更新。

Public Sub CopyRecords()

  Dim rstSource   As DAO.Recordset
  Dim rstInsert   As DAO.Recordset
  Dim fld         As DAO.Field
  Dim strSQL      As String
  Dim lngLoop     As Long
  Dim lngCount    As Long

  strSQL = "SELECT * FROM tblStatus WHERE Location = '" & _
                "DEFx" & "' Order by Total"

  ' Change this to the RecordsetClone of the subform.
  Set rstInsert = CurrentDb.OpenRecordset(strSQL)  

  Set rstSource = rstInsert.Clone
  With rstSource
    lngCount = .RecordCount
    For lngLoop = 1 To lngCount
      With rstInsert
        .AddNew
          For Each fld In rstSource.Fields
            With fld
              If .Attributes And dbAutoIncrField Then
                ' Skip Autonumber or GUID field.
              ElseIf .Name = "ParentID"  ' Name of FK.
                  rstInsert.Fields(.Name).Value = NewID  ' The new ID of the parent.
              ElseIf .Name = "Total" Then
                ' Insert some default value.
                rstInsert.Fields(.Name).Value = 0
              ElseIf .Name = "PROCESSED_IND" Then
                ' Empty a field.
                rstInsert.Fields(.Name).Value = Null
              Else
                ' Copy field content.
                rstInsert.Fields(.Name).Value = .Value
              End If
            End With
          Next
        .Update
      End With
      .MoveNext
    Next
    rstInsert.Close
    .Close
  End With

  Set rstInsert = Nothing
  Set rstSource = Nothing

End Sub