S
Synergy
This is a repost of a another message. I added info and stated the problem
was resolved, which didn't apply to this issue:
Here is a procedure which produces a duplicate record in an order entry
program, along with subform data. It has worked well for years in A97 and I
have no problems in A2002, but A2000 bombs out. Sometimes I get a duplicate
index error, but lately get this and error "Action Cancelled by an
Associated Object".
It occurs on the line marked below: ******ERROR OCCURING ON NEXT LINE
It is an AddNew method.
I believe it is an issue with A2000. I don't have the service packs
installed and am unable to, but my clients does and has this problem, so I
don't think that is the issue.
Thanks for any help.
Private Sub Copy_Record_Click()
On Error GoTo error_Section
'This Procedure makes a complete copy of the current record, but of course
it assigns a new Order Number
'<<-- A Is a grouping indicator for If...Then statements to keep the code
neat
'Recordset will be set when needed and cleared when not needed
'Vaiables are Dimmed in the General Module of this form
Dim dbs As Database
Dim rsDef As Recordset
Dim strJob As String 'Order number value to pass to Dialogbox
Dim ctl As Control
Dim lngID As Long
Dim lngOrdID As Long
Dim lngDetID As Long
Dim fld As Field
Dim strCriteria As String
Dim strCriteriaOrd As String
'Dim dtShipDate As Date
'dtShipDate = InputBox("Enter New Scheduled Ship Date!" & vbCrLf & vbCrLf &
"Leave Blank to use Sheduled Ship Date of this order!", , Date)
Set dbs = CurrentDb
Set rsDef = dbs.OpenRecordset("defaults", dbOpenDynaset)
'Assign order number
rsDef.MoveFirst
strJob = rsDef![ordnum] 'Assign next Job Number from default table
'Open dialogbox to display next job number. ALso give user a chance to
change number
'Job number selected will be validated before dialogbox is closed
DoCmd.OpenForm "OrderNewNum", , , , , acDialog, strJob 'Open Dialogbox
'Job Number was checked and is available
If pubNewNum = -1 Then '<<--A Cancel button was pushed on dialogbox.
Set rsDef = Nothing
Set dbs = Nothing
'Exit Sub
GoTo exit_Section
Else '<<--A Create the record, assign new number to it and go to it.
DoCmd.openform "Action Message", , , , , , "Duplicating Order"
Forms![Action Message].Repaint
DoEvents
'Duplicate HEADER Info
Dim rsOrder As Recordset
Set rsOrder = Me.RecordsetClone
strCriteriaOrd = "[OrdJob] =" & pubNewNum
******ERROR OCCURING ON NEXT LINE
rsOrder.AddNew
rsOrder![ordJob] = pubNewNum 'New Order Number Assigned to record
rsOrder![ordRecordCommited] = True
rsOrder![Date Updated] = Date + Time
For Each ctl In Me.Controls
If Parse(ctl.Tag, 3, ";") = "Dup" Then '<<--B The Controls to be
transferred have same names as Order Entry controls
rsOrder.Fields(ctl.Name) = ctl
End If '<<--B
Next ctl
lngOrdID = rsOrder![OrdID]
' If Not IsNull(dtShipDate) Then
' rsOrder![ordShipdate] = dtShipDate
' End If
rsOrder![ordReqDate] = Null
rsOrder![ordShipdate] = Null
rsOrder![ordStartDate] = Null
rsOrder![ordPO] = Null
rsOrder.Update
rsDef.Edit
rsDef![ordnum] = pubNewNum + 1 'Reassign default Order Numner
rsDef.Update
Set rsOrder = Nothing 'Clear recordset from memory - Not needed Now, will
Re Set later
Set rsDef = Nothing 'Clear recordset form memory - Not needed
'Duplicate the SUBFORM Info
'1) Products
Dim rsDupProducts As Recordset 'Products new record
Dim rsOrderProds As Recordset 'Products current record
'Duplicate Product info
'Retrieve [OrdId] from New record and create Products record in Table
[Order Entry ST Products]
Set rsDupProducts = dbs.OpenRecordset("Order Entry ST Products",
dbOpenDynaset) 'Duplicated Products
Set rsOrderProds = [ Products].Form.RecordsetClone 'Products of current
record
rsOrderProds.MoveFirst
'Do Until rsOrderProds.EOF
Do Until rsOrderProds.EOF 'A<-- Loop Existing Products
rsDupProducts.AddNew 'B<-- Update New product
For Each fld In rsOrderProds.Fields
On Error Resume Next
If Left(fld.Name, 3) = "Det" Then '<<--C
If Parse([ Products].Form.Controls(fld.Name).Tag, 3, ";") = "Dup"
Then 'Check corrsponding field contol's tag
rsDupProducts.Fields(fld.Name) = fld
rsDupProducts![OrdID] = lngOrdID
End If
End If '<<--C
Next fld
On Error GoTo error_Section
lngDetID = rsDupProducts![ordDetID] 'Child Field Value to be assigned to
new matrerials record
'If Not IsNull(dtShipDate) Then
' rsDupProducts![detShipDate] = dtShipDate
'End If
rsDupProducts.Update 'B<-- Update New product here to allow related
records to be added in the subtables
'---------------------------------------------------------------
'Add Materials for this product
Dim rsDupMaterials As Recordset 'Materials new record
Dim rsProdMats As Recordset 'Materials current record
'Duplicate Product info
Set rsDupMaterials = dbs.OpenRecordset("Order Entry ST Materials",
dbOpenDynaset) 'Materials of Duplicated Products
Set rsProdMats = dbs.OpenRecordset("Order Entry ST Materials",
dbOpenDynaset) 'Material of current product record
lngID = rsOrderProds![ordDetID] 'Used to find current existing
Material
strCriteria = "[ordDetID] = " & lngID
rsProdMats.FindFirst strCriteria 'Find original material for this
product
Do Until rsProdMats.NoMatch 'C<-- Loop Existing Material
rsDupMaterials.AddNew
For Each fld In rsProdMats.Fields
On Error Resume Next
'*If Left(fld.Name, 4) = "Prod" Then '<<--C
If Parse([Materials].Form.Controls(fld.Name).Tag, 3, ";") = "Dup"
Then 'Check corrsponding field contol's tag
rsDupMaterials.Fields(fld.Name) = fld
End If
'*End If '<<--C
Next fld
On Error GoTo error_Section
rsDupMaterials![ordDetID] = lngDetID 'Assign value to child field
rsDupMaterials.Update
rsProdMats.FindNext strCriteria
Loop 'C<-- Loop Existing Material
Set rsDupMaterials = Nothing 'Clear recordset from memory
Set rsProdMats = Nothing 'Clear recordset from memory
'Add Tasks for this product
Dim rsDupTasks As Recordset 'Tasks new record
Dim rsProdTasks As Recordset 'Tasks current record
'Duplicate Product info
Set rsDupTasks = dbs.OpenRecordset("Order Entry ST Tasks",
dbOpenDynaset) 'Tasks of Duplicated Products
Set rsProdTasks = dbs.OpenRecordset("Order Entry ST Tasks",
dbOpenDynaset) 'Tasks of current product record
lngID = rsOrderProds![ordDetID] 'Used to find current existing
Material
strCriteria = "[ordDetID] = " & lngID
rsProdTasks.FindFirst strCriteria 'Find original material for this
product
Do Until rsProdTasks.NoMatch 'C<-- Loop Existing Material
rsDupTasks.AddNew
For Each fld In rsProdTasks.Fields
On Error Resume Next
If fld.Name <> "custProdTaskID" Then
If Parse([Tasks].Form.Controls(fld.Name).Tag, 3, ";") = "Dup" Then
'Check corrsponding field contol's tag
rsDupTasks.Fields(fld.Name) = fld
End If
End If
Next fld
On Error GoTo error_Section
rsDupTasks![prodTaskComplete] = False 'Clear this field for new entry
rsDupTasks![prodTaskEmpNo] = 0 'Clear this field for new entry
rsDupTasks![ordDetID] = lngDetID 'Assign value to child field
rsDupTasks![prodTaskDateComplete] = Null
rsDupTasks.Update
rsProdTasks.FindNext strCriteria
Loop 'C<-- Loop Existing Material
Set rsDupTasks = Nothing 'Clear recordset from memory
Set rsProdTasks = Nothing 'Clear recordset from memory
'Add Subcontract Services for this product
Dim rsDupServices As Recordset 'Services new record
Dim rsProdServs As Recordset 'Services current record
'Duplicate Product info
Set rsDupServices = dbs.OpenRecordset("Order Entry ST Subcontract
Services", dbOpenDynaset) 'Materials of Duplicated Products
Set rsProdServs = dbs.OpenRecordset("Order Entry ST Subcontract
Services", dbOpenDynaset) 'Services of current product record
lngID = rsOrderProds![ordDetID] 'Used to find current existing Services
strCriteria = "[ordDetID] = " & lngID
rsProdServs.FindFirst strCriteria 'Find original Service for this
product
Do Until rsProdServs.NoMatch 'C<-- Loop Existing Service
rsDupServices.AddNew
For Each fld In rsProdServs.Fields
On Error Resume Next
If fld.Name <> "subContID" Then
If Parse([Subcontract Services].Form.Controls(fld.Name).Tag, 3, ";")
= "Dup" Then 'Check corrsponding field contol's tag
rsDupServices.Fields(fld.Name) = fld
End If
End If
Next fld
On Error GoTo error_Section
rsDupServices![ordDetID] = lngDetID 'Assign value to child field
rsDupServices.Update
rsProdServs.FindNext strCriteria
Loop 'C<-- Loop Existing Service
Set rsDupServices = Nothing 'Clear recordset from memory
Set rsProdServs = Nothing 'Clear recordset from memory
'---------------------------------------------------------------
rsOrderProds.FindFirst "[ordDetID] = " & lngID
rsOrderProds.MoveNext 'A<-- Loop Existing Products
Loop
Set rsDupProducts = Nothing 'Clear recordset from memory
Set rsOrderProds = Nothing 'Clear recordset from memory
'2)Tech Specs
Dim rsDupTechs As Recordset 'TechSpecs new record
Dim rsOrderTechs As Recordset 'TechSpecs current record
'Duplicate Technical info
Set rsDupTechs = dbs.OpenRecordset("Order Entry Technical Specs",
dbOpenDynaset) 'Duplicated Technical Specs
Set rsOrderTechs = [tech specs].Form.RecordsetClone 'Technical Specs of
current record
strCriteria = "[OrdID] = " & [OrdID]
rsOrderTechs.FindFirst strCriteria
'Do Until rsOrderTechs.EOF 'A<-- Loop Existing Technical Specs
rsDupTechs.AddNew 'B<-- Update New Technical Specs
For Each fld In rsOrderTechs.Fields
On Error Resume Next
'If Left(fld.Name, 3) = "Det" Then '<<--C
If fld.Name <> "ordTspecID" Then
rsDupTechs.Fields(fld.Name) = fld
rsDupTechs![OrdID] = lngOrdID
End If
'End If '<<--C
Next fld
On Error GoTo error_Section
rsDupTechs.Update 'B<-- Update New product here to allow related records
to be added in the subtables
'Loop
Set rsDupTechs = Nothing
Set rsOrderTechs = Nothing
'Find new Order on form
Set rsOrder = Me.RecordsetClone
strCriteriaOrd = "[ordID] =" & lngOrdID 'Reset strCriteriaOrd
rsOrder.FindFirst strCriteriaOrd
If Not rsOrder.NoMatch Then
pubNoRequery = True 'Prevent subforms in Order Entry from getting caught
in loop in CurrentEvent
Me.Bookmark = rsOrder.Bookmark
pubNoRequery = False
End If
[ordCustID].SetFocus
'Populate Shipping Info defaults from Customer Profile
Dim rs As Recordset
Set dbs = CurrentDb()
Set rs = dbs.OpenRecordset("Customers", dbOpenDynaset)
strCriteria = "[custID] = " & [ordCustID]
rs.FindFirst strCriteria
If Not rs.NoMatch Then 'Record was found so assign values to form
controls.
[ordCarrierName1] = rs![Ccarrier1]
[ordCarrierMethod1] = rs![Servtyp1]
If Not IsNull(rs![Ccarrier1]) And rs![Ccarrier1] <> "" Then
[ordCarrierTime] = DLookup("CarrierTime", "Carriers", "[CarrierName]
= '" & rs![Ccarrier1] & "'")
End If
'Rich wanted time brought over, and there was no good way to address
CarrierID so Carriername was
'used which is a Non Duplicate value, so acceptable.
[ordShipAccount1] = rs![Caccount1]
[ordCustFreightPaymentType] = rs![CustFreightPaymentType1]
'[ordShipSpecInst1] = rs![Dremarks] **Not storing default value- Only
new info
End If
End If '<<--A
exit_Section:
On Error Resume Next
DoCmd.Close acForm, "Action Message"
Set rsOrder = Nothing
Set rsDef = Nothing
Set rsDupProducts = Nothing
Set rsOrderProds = Nothing
MsgBox "New Order Created Successfully"
Exit Sub
error_Section:
MsgBox Err.Description
'Resume exit_Section
Stop
Resume Next
End Sub
was resolved, which didn't apply to this issue:
Here is a procedure which produces a duplicate record in an order entry
program, along with subform data. It has worked well for years in A97 and I
have no problems in A2002, but A2000 bombs out. Sometimes I get a duplicate
index error, but lately get this and error "Action Cancelled by an
Associated Object".
It occurs on the line marked below: ******ERROR OCCURING ON NEXT LINE
It is an AddNew method.
I believe it is an issue with A2000. I don't have the service packs
installed and am unable to, but my clients does and has this problem, so I
don't think that is the issue.
Thanks for any help.
Private Sub Copy_Record_Click()
On Error GoTo error_Section
'This Procedure makes a complete copy of the current record, but of course
it assigns a new Order Number
'<<-- A Is a grouping indicator for If...Then statements to keep the code
neat
'Recordset will be set when needed and cleared when not needed
'Vaiables are Dimmed in the General Module of this form
Dim dbs As Database
Dim rsDef As Recordset
Dim strJob As String 'Order number value to pass to Dialogbox
Dim ctl As Control
Dim lngID As Long
Dim lngOrdID As Long
Dim lngDetID As Long
Dim fld As Field
Dim strCriteria As String
Dim strCriteriaOrd As String
'Dim dtShipDate As Date
'dtShipDate = InputBox("Enter New Scheduled Ship Date!" & vbCrLf & vbCrLf &
"Leave Blank to use Sheduled Ship Date of this order!", , Date)
Set dbs = CurrentDb
Set rsDef = dbs.OpenRecordset("defaults", dbOpenDynaset)
'Assign order number
rsDef.MoveFirst
strJob = rsDef![ordnum] 'Assign next Job Number from default table
'Open dialogbox to display next job number. ALso give user a chance to
change number
'Job number selected will be validated before dialogbox is closed
DoCmd.OpenForm "OrderNewNum", , , , , acDialog, strJob 'Open Dialogbox
'Job Number was checked and is available
If pubNewNum = -1 Then '<<--A Cancel button was pushed on dialogbox.
Set rsDef = Nothing
Set dbs = Nothing
'Exit Sub
GoTo exit_Section
Else '<<--A Create the record, assign new number to it and go to it.
DoCmd.openform "Action Message", , , , , , "Duplicating Order"
Forms![Action Message].Repaint
DoEvents
'Duplicate HEADER Info
Dim rsOrder As Recordset
Set rsOrder = Me.RecordsetClone
strCriteriaOrd = "[OrdJob] =" & pubNewNum
******ERROR OCCURING ON NEXT LINE
rsOrder.AddNew
rsOrder![ordJob] = pubNewNum 'New Order Number Assigned to record
rsOrder![ordRecordCommited] = True
rsOrder![Date Updated] = Date + Time
For Each ctl In Me.Controls
If Parse(ctl.Tag, 3, ";") = "Dup" Then '<<--B The Controls to be
transferred have same names as Order Entry controls
rsOrder.Fields(ctl.Name) = ctl
End If '<<--B
Next ctl
lngOrdID = rsOrder![OrdID]
' If Not IsNull(dtShipDate) Then
' rsOrder![ordShipdate] = dtShipDate
' End If
rsOrder![ordReqDate] = Null
rsOrder![ordShipdate] = Null
rsOrder![ordStartDate] = Null
rsOrder![ordPO] = Null
rsOrder.Update
rsDef.Edit
rsDef![ordnum] = pubNewNum + 1 'Reassign default Order Numner
rsDef.Update
Set rsOrder = Nothing 'Clear recordset from memory - Not needed Now, will
Re Set later
Set rsDef = Nothing 'Clear recordset form memory - Not needed
'Duplicate the SUBFORM Info
'1) Products
Dim rsDupProducts As Recordset 'Products new record
Dim rsOrderProds As Recordset 'Products current record
'Duplicate Product info
'Retrieve [OrdId] from New record and create Products record in Table
[Order Entry ST Products]
Set rsDupProducts = dbs.OpenRecordset("Order Entry ST Products",
dbOpenDynaset) 'Duplicated Products
Set rsOrderProds = [ Products].Form.RecordsetClone 'Products of current
record
rsOrderProds.MoveFirst
'Do Until rsOrderProds.EOF
Do Until rsOrderProds.EOF 'A<-- Loop Existing Products
rsDupProducts.AddNew 'B<-- Update New product
For Each fld In rsOrderProds.Fields
On Error Resume Next
If Left(fld.Name, 3) = "Det" Then '<<--C
If Parse([ Products].Form.Controls(fld.Name).Tag, 3, ";") = "Dup"
Then 'Check corrsponding field contol's tag
rsDupProducts.Fields(fld.Name) = fld
rsDupProducts![OrdID] = lngOrdID
End If
End If '<<--C
Next fld
On Error GoTo error_Section
lngDetID = rsDupProducts![ordDetID] 'Child Field Value to be assigned to
new matrerials record
'If Not IsNull(dtShipDate) Then
' rsDupProducts![detShipDate] = dtShipDate
'End If
rsDupProducts.Update 'B<-- Update New product here to allow related
records to be added in the subtables
'---------------------------------------------------------------
'Add Materials for this product
Dim rsDupMaterials As Recordset 'Materials new record
Dim rsProdMats As Recordset 'Materials current record
'Duplicate Product info
Set rsDupMaterials = dbs.OpenRecordset("Order Entry ST Materials",
dbOpenDynaset) 'Materials of Duplicated Products
Set rsProdMats = dbs.OpenRecordset("Order Entry ST Materials",
dbOpenDynaset) 'Material of current product record
lngID = rsOrderProds![ordDetID] 'Used to find current existing
Material
strCriteria = "[ordDetID] = " & lngID
rsProdMats.FindFirst strCriteria 'Find original material for this
product
Do Until rsProdMats.NoMatch 'C<-- Loop Existing Material
rsDupMaterials.AddNew
For Each fld In rsProdMats.Fields
On Error Resume Next
'*If Left(fld.Name, 4) = "Prod" Then '<<--C
If Parse([Materials].Form.Controls(fld.Name).Tag, 3, ";") = "Dup"
Then 'Check corrsponding field contol's tag
rsDupMaterials.Fields(fld.Name) = fld
End If
'*End If '<<--C
Next fld
On Error GoTo error_Section
rsDupMaterials![ordDetID] = lngDetID 'Assign value to child field
rsDupMaterials.Update
rsProdMats.FindNext strCriteria
Loop 'C<-- Loop Existing Material
Set rsDupMaterials = Nothing 'Clear recordset from memory
Set rsProdMats = Nothing 'Clear recordset from memory
'Add Tasks for this product
Dim rsDupTasks As Recordset 'Tasks new record
Dim rsProdTasks As Recordset 'Tasks current record
'Duplicate Product info
Set rsDupTasks = dbs.OpenRecordset("Order Entry ST Tasks",
dbOpenDynaset) 'Tasks of Duplicated Products
Set rsProdTasks = dbs.OpenRecordset("Order Entry ST Tasks",
dbOpenDynaset) 'Tasks of current product record
lngID = rsOrderProds![ordDetID] 'Used to find current existing
Material
strCriteria = "[ordDetID] = " & lngID
rsProdTasks.FindFirst strCriteria 'Find original material for this
product
Do Until rsProdTasks.NoMatch 'C<-- Loop Existing Material
rsDupTasks.AddNew
For Each fld In rsProdTasks.Fields
On Error Resume Next
If fld.Name <> "custProdTaskID" Then
If Parse([Tasks].Form.Controls(fld.Name).Tag, 3, ";") = "Dup" Then
'Check corrsponding field contol's tag
rsDupTasks.Fields(fld.Name) = fld
End If
End If
Next fld
On Error GoTo error_Section
rsDupTasks![prodTaskComplete] = False 'Clear this field for new entry
rsDupTasks![prodTaskEmpNo] = 0 'Clear this field for new entry
rsDupTasks![ordDetID] = lngDetID 'Assign value to child field
rsDupTasks![prodTaskDateComplete] = Null
rsDupTasks.Update
rsProdTasks.FindNext strCriteria
Loop 'C<-- Loop Existing Material
Set rsDupTasks = Nothing 'Clear recordset from memory
Set rsProdTasks = Nothing 'Clear recordset from memory
'Add Subcontract Services for this product
Dim rsDupServices As Recordset 'Services new record
Dim rsProdServs As Recordset 'Services current record
'Duplicate Product info
Set rsDupServices = dbs.OpenRecordset("Order Entry ST Subcontract
Services", dbOpenDynaset) 'Materials of Duplicated Products
Set rsProdServs = dbs.OpenRecordset("Order Entry ST Subcontract
Services", dbOpenDynaset) 'Services of current product record
lngID = rsOrderProds![ordDetID] 'Used to find current existing Services
strCriteria = "[ordDetID] = " & lngID
rsProdServs.FindFirst strCriteria 'Find original Service for this
product
Do Until rsProdServs.NoMatch 'C<-- Loop Existing Service
rsDupServices.AddNew
For Each fld In rsProdServs.Fields
On Error Resume Next
If fld.Name <> "subContID" Then
If Parse([Subcontract Services].Form.Controls(fld.Name).Tag, 3, ";")
= "Dup" Then 'Check corrsponding field contol's tag
rsDupServices.Fields(fld.Name) = fld
End If
End If
Next fld
On Error GoTo error_Section
rsDupServices![ordDetID] = lngDetID 'Assign value to child field
rsDupServices.Update
rsProdServs.FindNext strCriteria
Loop 'C<-- Loop Existing Service
Set rsDupServices = Nothing 'Clear recordset from memory
Set rsProdServs = Nothing 'Clear recordset from memory
'---------------------------------------------------------------
rsOrderProds.FindFirst "[ordDetID] = " & lngID
rsOrderProds.MoveNext 'A<-- Loop Existing Products
Loop
Set rsDupProducts = Nothing 'Clear recordset from memory
Set rsOrderProds = Nothing 'Clear recordset from memory
'2)Tech Specs
Dim rsDupTechs As Recordset 'TechSpecs new record
Dim rsOrderTechs As Recordset 'TechSpecs current record
'Duplicate Technical info
Set rsDupTechs = dbs.OpenRecordset("Order Entry Technical Specs",
dbOpenDynaset) 'Duplicated Technical Specs
Set rsOrderTechs = [tech specs].Form.RecordsetClone 'Technical Specs of
current record
strCriteria = "[OrdID] = " & [OrdID]
rsOrderTechs.FindFirst strCriteria
'Do Until rsOrderTechs.EOF 'A<-- Loop Existing Technical Specs
rsDupTechs.AddNew 'B<-- Update New Technical Specs
For Each fld In rsOrderTechs.Fields
On Error Resume Next
'If Left(fld.Name, 3) = "Det" Then '<<--C
If fld.Name <> "ordTspecID" Then
rsDupTechs.Fields(fld.Name) = fld
rsDupTechs![OrdID] = lngOrdID
End If
'End If '<<--C
Next fld
On Error GoTo error_Section
rsDupTechs.Update 'B<-- Update New product here to allow related records
to be added in the subtables
'Loop
Set rsDupTechs = Nothing
Set rsOrderTechs = Nothing
'Find new Order on form
Set rsOrder = Me.RecordsetClone
strCriteriaOrd = "[ordID] =" & lngOrdID 'Reset strCriteriaOrd
rsOrder.FindFirst strCriteriaOrd
If Not rsOrder.NoMatch Then
pubNoRequery = True 'Prevent subforms in Order Entry from getting caught
in loop in CurrentEvent
Me.Bookmark = rsOrder.Bookmark
pubNoRequery = False
End If
[ordCustID].SetFocus
'Populate Shipping Info defaults from Customer Profile
Dim rs As Recordset
Set dbs = CurrentDb()
Set rs = dbs.OpenRecordset("Customers", dbOpenDynaset)
strCriteria = "[custID] = " & [ordCustID]
rs.FindFirst strCriteria
If Not rs.NoMatch Then 'Record was found so assign values to form
controls.
[ordCarrierName1] = rs![Ccarrier1]
[ordCarrierMethod1] = rs![Servtyp1]
If Not IsNull(rs![Ccarrier1]) And rs![Ccarrier1] <> "" Then
[ordCarrierTime] = DLookup("CarrierTime", "Carriers", "[CarrierName]
= '" & rs![Ccarrier1] & "'")
End If
'Rich wanted time brought over, and there was no good way to address
CarrierID so Carriername was
'used which is a Non Duplicate value, so acceptable.
[ordShipAccount1] = rs![Caccount1]
[ordCustFreightPaymentType] = rs![CustFreightPaymentType1]
'[ordShipSpecInst1] = rs![Dremarks] **Not storing default value- Only
new info
End If
End If '<<--A
exit_Section:
On Error Resume Next
DoCmd.Close acForm, "Action Message"
Set rsOrder = Nothing
Set rsDef = Nothing
Set rsDupProducts = Nothing
Set rsOrderProds = Nothing
MsgBox "New Order Created Successfully"
Exit Sub
error_Section:
MsgBox Err.Description
'Resume exit_Section
Stop
Resume Next
End Sub