Solved Not sure why my code Isnt working any help? (1 Viewer)

[Sodslaw]

Hi!
I have taken a standard code for duplicating a form with its subform, but it falls over when trying to append the subform to its table....

Private Sub OrderCopy_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
               '!OwnerID = Me.OwnerID
                !TBLCustomerID = Me.TBLCustomerID
                !OrderDate = Me.OrderDate
                !OrderType = Me.OrderType
                !EmployeeID = Me.EmployeeID
                !ProjectRef = Me.ProjectRef
              ' !PONo = Me.PONo
                !SalesRegion = Me.SalesRegion
                !Commision = Me.Commision
              ' !SpecNo = Me.SpecNo
                !Notes = Me.Notes
                !OrderMainText = Me.OrderMainText
                !DocumentsInc = Me.DocumentsInc
                !DrawInc = Me.DrawInc
               '!SupplyType = Me.SupplyType
            .Update
          
            'Save the primary key value, to use as the foreign key for the related records.
            .Bookmark = .LastModified
            lngID = !OrderID
          
            'Duplicate the related records: append query.
            If Me.[FRmQ_OrderItemSUB].Form.RecordsetClone.RecordCount > 0 Then
                strSQL = "INSERT INTO TblOrderitem ( OrderMainLink, PartNo, Description, Qty, UnitPrice, SubPrice, OrderItem_Spec, Location, Supply, DelTime ) " & _
                "SELECT " & lngID & " As NewID, PartNo, Description, Qty, UnitPrice, SubPrice, OrderItem_Spec, Location, Supply, DelTime " & _
                "FROM TblOrderitem  WHERE OrderLinkID = " & Me.OrderID & ";"
                Debug.Print strSQL
                DBEngine(0)(0).Execute strSQL, dbFailOnError
            Else
                MsgBox "Main record duplicated, but there were no Order Items to Copy."
            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

Reports an RT error 1034 "Too Few Parameters. Expected 1"
Error is @ Line

 DBEngine(0)(0).Execute strSQL, dbFailOnError

(dbFailOnError=128)
Debug.Print strSQL ....
INSERT INTO TblOrderitem ( OrderMainLink, PartNo, Description, Qty, UnitPrice, SubPrice, OrderItem_Spec, Location, Supply, DelTime ) SELECT 113 As NewID, PartNo, Description, QTY, UnitPrice, SubPrice, OrderItem_Spec, Location, Supply, DelTime FROM TblOrderitem WHERE OrderLinkID = 84;

Im pretty sure the rest of the code is fine, but cant figure it out the error, please help.

 

[Gasman]

Does the sql work if you paste it into a sql window and run it?

 

[Sodslaw]

@Gasman thanks for your speedy reply
The SQL i have tried...

INSERT INTO TblOrderitem ( OrderMainLink, PartNo, Description, Qty, UnitPrice, SubPrice, OrderItem_Spec, Location, Supply, DelTime )
SELECT 113 As NewID, PartNo, Description, Qty, UnitPrice, SubPrice, OrderItem_Spec, Location, Supply, DelTime
FROM TblOrderitem  WHERE OrderLinkID = 24;

It asks for the OrderLinkID once again in a little pop up (is this the problem?) if I enter 24 result is, "You are about to paste 39 rows"
if i enter 113 as the OrderLinkID then it shows the result "You are about to paste 0 rows"

so im not sure if its working properly or not. 39 or 0 rows is not correct it should be 9 rows (39 is all records)

Hope this helps

 

[Gasman]

Sounds like it does not recognise orderlinkid?
Is that the correct name? Try prefixing with table name.
However that is your initial problem. How many records get updated is down to your data.

 

[Sodslaw]

@gasmanAll working now thank you... I needed your fresh pair of eyes and experience. issue was naming of the feild OrderLinkID

 

[Uncle Gizmo]

I found some code on stack overflow that duplicated the Main Form Record and Subform Record. However, you needed to edit the code by adding the relevant fields and Subform references into it. You also needed to duplicate the code necessary to to operate on every single subform. I realised there might be a way to make it generic. I set about modifying it so that it is completely generic. Just place the code in your form module, call it from a command button and hey presto you will have a new record containing all of the information from the main form, and from any subforms that are marked with an X in the subform/subreport controls Tag property.

Form / Subform Record Duplicator:-

Private Sub btnDuplicateRec_Click()
    Call fCopy
End Sub

Private Sub fCopy()
'Purpose:   Duplicate the Main Form Record and related Subform Records for ALL Subforms Tagged X
'From
'https://stackoverflow.com/questions/55392894/ms-access-is-there-an-easy-way-to-duplicate-field-information-of-a-form-and-it/55393154#55393154

'Make sure there is a record to duplicate.
If Me.NewRecord Then
    MsgBox "NOT A VALID RECORD!!! Select another Record...."
    Exit Sub
End If

Dim rst             As DAO.Recordset
Dim rstAdd          As DAO.Recordset
Dim fld             As DAO.Field
Dim intCount        As Integer
Dim intItem         As Integer
Dim varBookmark     As Variant
Dim strMainFrmID    As String
Dim lngNewId        As Long
Dim strChildFld     As String

    'Copy Parent Records
    Set rstAdd = Me.RecordsetClone
    Set rst = rstAdd.Clone
  
    'Move to Current Record
    rst.Bookmark = Me.Bookmark
  
    With rstAdd
        .AddNew
        For Each fld In .Fields
            With fld
                'If Attributes is True and dbAutoIncrField is True
                If .Attributes And dbAutoIncrField Then
                    'Skip Autonumber or GUID Field.
                    'Get Auto Incr Field Name from the Main Form
                    strMainFrmID = rst.Fields(.Name).Name
                Else
                    .Value = rst.Fields(.Name).Value
                End If
            End With
        Next
        .Update
        .MoveLast
      
        'Pick ID of the New Record to Use in The Subform Code
        lngNewId = rstAdd(strMainFrmID).Value
    End With
  
    'Store Location of New Record.
    varBookmark = rstAdd.Bookmark
  
    'Copy ALL Subform Child Records
    Dim Ctrl As Control
    For Each Ctrl In Me.Controls
        Select Case Ctrl.ControlType
            Case acSubform
          
            If Ctrl.Tag = "X" Then
              
                'Get the Subform/Subreport Control Child Field
                strChildFld = Ctrl.LinkChildFields
      
                Set rstAdd = Ctrl.Form.RecordsetClone
                Set rst = rstAdd.Clone
              
                If rstAdd.RecordCount > 0 Then
                    rstAdd.MoveLast
                    rstAdd.MoveFirst
                End If
              
                intCount = rstAdd.RecordCount
                For intItem = 1 To intCount
                    With rstAdd
                        .AddNew
                        For Each fld In .Fields
                            With fld
                          
                                'If Attributes is True and dbAutoIncrField is True
                                If .Attributes And dbAutoIncrField Then
                                    'Skip Autonumber or GUID Field.
                                ElseIf .Name = strChildFld Then
                                    'Set the Child Field to the ID in the Main Form.
                                    .Value = lngNewId
                                Else
                                    .Value = rst.Fields(.Name).Value
                                End If
                            End With
                        Next
                        .Update
                    End With
                    rst.MoveNext
                Next
            End If
        End Select
    Next Ctrl
  
rst.Close
rstAdd.Close

' Move to the New Record Copy.
Me.Bookmark = varBookmark

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

End Sub      'fCopy