vba - 具有多值字段和子表单的重复表单按钮

Question

我正在尝试使用 vba 从按钮复制​​表单。多年来，使用 Allen Browne 的“在表格和子表格中复制记录”一直有效。http://allenbrowne.com/ser-57.html

现在我想将其中一个字段更改为多值。我理解多值字段的困难，但这是一个有 10 年历史的数据库，我需要做的就是让这个字段能够存储多个值，所以认为这比创建新的连接表和更新所有相关内容更容易。

我目前在 rstmv = rstmv.Value 行中对 Property 的使用无效。

我尝试了许多版本并得到不同的错误。我想我应该将多值字段的值作为单独的记录集打开，更新它然后循环遍历这些值，但我很困惑，因为我不确定我在做什么。

这是我一直在使用的代码：

'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.
    Dim rst As Recordset
    Dim rstmv  As Recordset2
    
        'Save and 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
                !Site_Name = Me.Site_Name
                !Date_of_Dive = Me.Date_of_Dive
                !Time_of_Dive = Me.Time
                
     Set rst = Me.RecordsetClone
       Set rstmv = rst!Staff.Value
                
                Do While Not rstmv.EOF
    
   rsp.Edit
    rstmv.Edit
    
    
    rstmv.AddNew ' Add a new record to the asp Recordset
    rstmv = rstmv.Value
    rstmv.Update ' Commit the changes to the asp Recordset
    imt.MoveNext
Loop
    .Update
               
                !O2 = Me.O2
                !First_Aid = Me.First_Aid
        !Spares = Me.Spares

'etc for other fields.
            .Update
            
            'Save the primary key value, to use as the foreign key for the related records.
            .Bookmark = .LastModified
            lngID = !Dive_Number
            
            'Duplicate the related records: append query.
            If Me.[DiveDetailssubform].Form.RecordsetClone.RecordCount > 0 Then
                strSql = "INSERT INTO [DiveDetails] (Dive_Number, CustDateID, Type, Price) " & _
                    "SELECT " & lngID & " As NewID, CustDateID, Type, Price " & _
                    "FROM [DiveDetails] WHERE Dive_Number = " & Me.Dive_Number & ";"
                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
         MsgBox "Dive Sucessfully Duplicated. DONT FORGET TO CHANGE THE SITE NAME."
        
        End With
    End If

Exit_Handler:
    Exit Sub

Err_Handler:
    MsgBox "Error " & Err.Number & " - " & Err.Description, , "Duplicate_Click"
    Resume Exit_Handler
End Sub





Private Sub Form_Load()
    Dim varID As Variant
    Dim strDelim As String
    'Note: If CustomerID field is a Text field (not a Number field), remove single quote at start of next line.
    'strDelim = """"

    varID = DLookup("Value", "tblSys", "[Variable] = 'DiveIDLast'")
    If IsNumeric(varID) Then
        With Me.RecordsetClone
            .FindFirst "[dive_number] = " & strDelim & varID & strDelim
            If Not .NoMatch Then
                Me.Bookmark = .Bookmark
            End If
        End With
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim rs As DAO.Recordset

    If Not IsNull(Me.Dive_Number) Then
        Set rs = CurrentDb().OpenRecordset("tblSys", dbOpenDynaset)
        With rs
            .FindFirst "[Variable] = 'DiveIDLast'"
            If .NoMatch Then
                .AddNew        'Create the entry if not found.
                    ![Variable] = "DiveIDLast"
                    ![Value] = Me.Dive_Number
                    ![Description] = "Last DiveID, for form Dive Planner" & Me.Name
                .Update
            Else
                .Edit          'Save the current record's primary key.
                    ![Value] = Me.Dive_Number
                .Update
            End If
        End With
        rs.Close
    End If
    Set rs = Nothing
End Sub

标签： vbams-accessmultivalue

Answer 1

需要源数据记录集和目标记录集。还应该将记录集类型显式声明为 DAO。考虑：

    Dim strSql As String    'SQL statement.
    Dim lngID As Long       'Primary key value of the new record.
    Dim rstF As DAO.Recordset
    Dim rstT As DAO.Recordset
    Dim rstmvF As DAO.Recordset2
    Dim rstmvT As DAO.Recordset2
    
    '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
        Set rstF = CurrentDb.OpenRecordset("SELECT * FROM Dives WHERE Dive_Number = " & Me.Dive_number)
        Set rstmvF = rstF!Staff.Value

        'Duplicate the main record: add to form's clone.
        With Me.RecordsetClone
            .AddNew
            !Site_Name = Me.Site_Name
            !Date_of_Dive = Me.Date_of_Dive
            !Time_of_Dive = Me.Time
            !O2 = Me.O2
            !First_Aid = Me.First_Aid
            !Spares = Me.Spares
            .Update

            'Save the primary key value of new record.
            .Bookmark = .LastModified
            lngID = !Dive_number
            Set rstT = CurrentDb.OpenRecordset("SELECT * FROM Dives WHERE Dive_Number = " & lngID)
            Set rstmvT = rstT!Staff.Value
            rstT.Edit
            Do While Not rstmvF.EOF
                rstmvT.AddNew ' Add a new record to the asp Recordset
                rstmvT!Value = rstmvF!Value
                rstmvT.Update ' Commit the changes to the asp Recordset
                rstmvF.MoveNext
            Loop
            rstT.Update