Problem with order detail in OE1100.ocx ver 6.0 1

[PJ71]

I am having trouble updating the order to Accpac 6.0a. The order header populates fine but have the following error on the detail "internal error. Order Detail. Operation not allowed

 

[PJ71]

I have included the code below
Private Sub FillForm()
Dim i As Integer
Dim stST As String
Dim PauseTime, start
Dim bForm As Boolean
On Error GoTo FillForm_Err
PauseTime = gsngPostingPause
Set mDetDB = AccpacOE1100UICtrl1.UIDSControls(18)
Set mHedDB = AccpacOE1100UICtrl1.UIDSControls(37)
rsTempOrderHeader.MoveFirst
Do While Not rsTempOrderHeader.EOF
If rsTmpStock.State Then rsTmpStock.Close
rsTmpStock.Open "Select [Order no] as OrderNo, [lineNo], StockCode, [Quantity invoiced] as Qty, [InvoiceNo] From TempOrderDetail WHERE ([Order no] = '" & rsTempOrderHeader!OrderNo & "') AND ([Quantity invoiced] > 0) Order By StockCode", connOMD, adOpenStatic, adLockOptimistic
If rsTmpStock.RecordCount Then
With AccpacOE1100UICtrl1
bForm = .UIAppControls(4).Name = "fecOEORDH_LastShipNumber"
If AccCheckQty(rsTmpStock) Then
If rsTempOrderHeader.AbsolutePosition = 1 Then
If bForm Then
stST = .UIAppControls(8).value
Else
stST = .UIAppControls(9).value
End If
Else
If bForm Then
.UIAppControls(8).value = stST
Else
.UIAppControls(9).value = stST
End If
DoEvents
End If
DoEvents
If bForm Then
.UIAppControls(8).value = Left(rsTempOrderHeader!CustomerCode, 5)
DoEvents
.UIAppControls(76).value = gsLocation
DoEvents
.UIAppControls(82).value = rsTempOrderHeader!OrderNo
DoEvents
.UIAppControls(79).value = rsTempOrderHeader!CustomerOrder
Else
.UIAppControls(9).value = Left(rsTempOrderHeader!CustomerCode, 5)
DoEvents
.UIAppControls(77).value = gsLocation
DoEvents
.UIAppControls(83).value = rsTempOrderHeader!OrderNo
DoEvents
.UIAppControls(80).value = rsTempOrderHeader!CustomerOrder
End If
DoEvents
If Len(Trim(rsTempOrderHeader!ShipTo)) = 0 Then
If InStr(1, rsTempOrderHeader!DeliveryAddress, vbNewLine) Then
arr = Split(rsTempOrderHeader!DeliveryAddress, vbNewLine)
mHedDB.Fields("SHPNAME") = arr(0)
mHedDB.Fields("SHPADDR1") = arr(1)
mHedDB.Fields("SHPADDR2") = arr(2)
mHedDB.Fields("SHPADDR3") = arr(3)
mHedDB.Fields("SHPADDR4") = arr(4)
mHedDB.Fields("SHPCITY") = arr(5)
End If
Else
If bForm Then
.UIAppControls(84).value = rsTempOrderHeader!ShipTo
Else
.UIAppControls(84).value = rsTempOrderHeader!ShipTo
End If
End If
If dLookup(connCoy, "Count(*)", "ARSAP", "CODESLSP ='" & rsTempOrderHeader!SalesMan & "'", , , True) = 0 Then RaiseError 1032, "Salesman Code " & rsTempOrderHeader!SalesMan
mHedDB.Fields("SALESPER1") = rsTempOrderHeader!SalesMan
mHedDB.Fields("SALESPLT1") = 100
DoEvents
rsTmpStock.MoveFirst
Do While Not rsTmpStock.EOF
If rsTmpStock.AbsolutePosition > 1 Then mDetDB.Insert
mDetDB.Fields("LINENUM").value = rsTmpStock.AbsolutePosition
mDetDB.Fields("ITEM").value = rsTmpStock!StockCode
mDetDB.Fields("QTYORDERED").value = rsTmpStock!Qty
mDetDB.Fields("LOCATION").value = gsLocation
DoEvents
rsTmpStock.MoveNext
Loop
.SetFocus
start = Timer
Do While Timer < start + PauseTime
DoEvents
Loop
If bForm Then
.UIAppControls(41).SetFocus
Else
.UIAppControls(42).SetFocus
End If
SendKeys "{Enter}"
start = Timer
Do While Timer < start + PauseTime
DoEvents
Loop
.SuppressPostedMessage = True
If bForm Then
.UIAppControls(11).SetFocus
Else
.UIAppControls(12).SetFocus
End If
SendKeys "{Enter}"
start = Timer
If bForm Then
Do While .UIAppControls(9).value = stST
If Timer > start + PauseTime * 10 Then RaiseError 1006
DoEvents
Loop
rsTempOrderHeader.Update "ORDNUMBER", .UIAppControls(9).value
Else
Do While .UIAppControls(10).value = stST
If Timer > start + PauseTime * 10 Then RaiseError 1006
DoEvents
Loop
rsTempOrderHeader.Update "ORDNUMBER", .UIAppControls(10).value
End If

End If
' .CloseUIApp
End With
InvoicePrintUpdate
Else
MsgBox "Order " & rsTempOrderHeader!OrderNo & " Has No Stock", vbInformation + vbOKOnly, "Error"
If rsTempOrderHeader.AbsolutePosition = 1 Then
If bForm Then
stST = AccpacOE1100UICtrl1.UIAppControls(9).value
Else
stST = AccpacOE1100UICtrl1.UIAppControls(10).value
End If
End If
End If
rsTempOrderHeader.MoveNext
Loop
' AccpacOE1100UICtrl1.CloseUIApp
If bForm Then
AccpacOE1100UICtrl1.UIAppControls(11).SetFocus
Else
AccpacOE1100UICtrl1.UIAppControls(12).SetFocus
End If
SendKeys "{Enter}"
Exit Sub
FillForm_Err:
DisplayError "AccPac Posting"
AccpacOE1100UICtrl1.CloseUIApp
End Sub

 

[Jay Converse]

That some of the ugliest code I've seen in decades. What are you trying to do?

 

[ettienne]

You are writing to a field that is read only. Figure out which line it is failing on and go from there.