vbams-accessmultivalue

Duplicate form button with multivalued field and subform


I am trying to duplicate a form from a button using vba. This has worked for years using Allen Browne's "Duplicate the record in form and subform." http://allenbrowne.com/ser-57.html

Now I want to change one of the fields to multivalue. I understand the difficulties with multivalued fields, but this is a 10 year old database and all I need to do is make this field be able to store multiple values, so think this will be easier than creating a new join table and updating everything related.

I am currently getting Invalid use of Property at the rstmv = rstmv.Value line.

I have tried numerous versions and get different errors. I think I should be opening the values of the multi-value field as a separate recordset, updating it then looping through the values but I am getting confused as I am not really sure what I am doing.

Here is the code I I have been using:


'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


Solution

  • Need recordsets of source data and recordsets for destination. Also should explicitly declare the recordset type as DAO. Consider:

        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