Creating a Transactional Object (SOEProj.vbp)

This sample code shows how to create a SalesOrderEntry transactional object (SOETxObject => SOEClass2.cls).

Public Sub run()
On Error GoTo errorhandler
Dim ow As OneWorldTx

 Dim bhvr As IOneWorldBHVRCOM
  
 Dim conn As New Connector           '// COM Connector
 Dim connRole As IConnector2         '// Connector Interface with Roles

 Dim soeObject As JDESalesOrderEntry '// SalesOrderEntry
 Dim soeBeginDoc As D4200310H
 Dim soeEndDoc As D4200310G
 Dim soeEditLine As D4200310F
 Dim soeClearWF As D4200310I
 Dim s As String
 Dim d As New MathNumeric
 Dim mnQuanityOrdered As New MathNumeric
 Dim mnUnitPrice As New MathNumeric
 Dim response

 Dim laccessNunber As Long

 ' Name Information
 Dim strComputerName As String
 Dim lngNameLength As Long

 Const WRITE_FLAG = "2"

 Dim i As Boolean
 Set connRole = conn
 laccessNumber = connRole.Login("UserID", "PWD", "ENV", "ROLE")

 Set ow = New OneWorldTx

 ow.Initialize laccessNumber, connRole
 'oneworld transaction initialized to manual
 ow.BeginTransaction laccessNumber, connRole, 1

 Set bhvr = ow
 bhvr.szApplication = "COM+"
 Set soeObject = connRole.CreateBusinessObject("SalesOrderEntry.
JDESalesOrderEntry", laccessNumber) 
' please change the progid to correct progId
 Set soeBeginDoc = soeObject.CreateF4211FSBeginDocParameterset
 Set soeEditLine = soeObject.CreateF4211FSEditLineParameterset
 Set soeEndDoc = soeObject.CreateF4211FSEndDocParameterset
 Set soeClearWF = soeObject.CreateF4211ClearWorkFileParameterset

 ' Get computer name for use later
 strComputerName = Space(30)
 lngNameLength = 30
 p_ret = GetComputerName(strComputerName, lngNameLength)
 If p_ret <> 1 Then
   MsgBox (GetComputerName failed!)
   'End
 Else
   strComputerName = Mid(strComputerName, 1, lngNameLength)
 End If
 ' MsgBox (Create Biz Object Done!)

 '//////////////BEGIN DOC//////////////
 soeBeginDoc.Reset
 soeBeginDoc.cCMDocAction = "A"
 soeBeginDoc.cCMProcessEdits = "1"
 soeBeginDoc.cCMUpdateWriteToWF = WRITE_FLAG
 soeBeginDoc.szCMProgramID = "VB"
 soeBeginDoc.szCMVersion = "ZJDE0001"
 soeBeginDoc.szOrderCo = "00200"
 soeBeginDoc.szOrderType = "SO"
 szBUnit = "M30"
 soeBeginDoc.szBusinessUnit = Space(12 - Len(szBUnit)) + szBUnit
 d = Val("4242")
 soeBeginDoc.mnAddressNumber = d
 soeBeginDoc.mnShipToNo = d
 soeBeginDoc.jdOrderDate = Date
 soeBeginDoc.cMode = "F"
 soeBeginDoc.szUserID = "JDE"
 soeBeginDoc.cRetrieveOrderNo = "1"

 If strComputerName <> "" Then
     soeBeginDoc.szCMComputerID = strComputerName
 End If
 ' MsgBox ("Before F4211FSBeginDoc")
 soeObject.F4211FSBeginDoc soeBeginDoc, ow, connRole, laccessNumber

 MsgBox Round(soeBeginDoc.mnOrderNo, 0)

 '//////////EDIT LINE////////////
    
 soeEditLine.mnCMJobNo = soeBeginDoc.mnCMJobNumber
 orderNum = soeBeginDoc.mnOrderNo
 soeEditLine.mnOrderNo = soeBeginDoc.mnOrderNo
 soeEditLine.szBusinessUnit = soeBeginDoc.szBusinessUnit
 soeEditLine.szCMComputerID = soeBeginDoc.szCMComputerID
 soeEditLine.cCMWriteToWFFlag = WRITE_FLAG

 soeEditLine.szOrderType = soeBeginDoc.szOrderType
 ' Load items from UI into edit line structure
 soeEditLine.szItemNo = "1001"
 mnQuanlityOrdered = "2"
 soeEditLine.mnQtyOrdered = mnQuanityOrdered

 ' MsgBox ("Before F4211FSEditLine.")
 ' Call business function
 soeObject.F4211FSEditLine soeEditLine, ow, connRole, laccessNumber
 ' MsgBox ("After F4211FSEditLine.")
  
 '///////////////ENDDOC//////////////
 soeEndDoc.mnCMJobNo = soeBeginDoc.mnCMJobNumber
 soeEndDoc.mnSalesOrderNo = soeBeginDoc.mnOrderNo
 soeEndDoc.szOrderType = soeBeginDoc.szOrderType
 soeEndDoc.szCMComputerID = strComputerName
 soeEndDoc.cCMUseWorkFiles = WRITE_FLAG
 'Call business function
 
  'MsgBox ("Before F4211FSEndDoc.")
 soeObject.F4211FSEndDoc soeEndDoc, ow, connRole, laccessNumber
 'MsgBox ("After F4211FSEndDoc.")
 MsgBoxRes = MsgBox("Do you want to abort?", vbYesNo, "Transaction 
Decision")
 If MsgBoxRes = vbYes Then
   GetObjectContext.SetAbort
 Else
   GetObjectContext.SetComplete
   MsgBox ("Order Saved")
 End If
    
 '///////CLEAR WORK FILE////////////////

 soeClearWF.cClearDetailWF = WRITE_FLAG
 soeClearWF.cClearHeaderWF = WRITE_FLAG
 soeClearWF.mnJobNo = soeBeginDoc.mnCMJobNumber
 soeClearWF.szComputerID = strComputerName
 'Call business function
 'MsgBox ("Before F4211ClearWorkFile.")
 ow.BeginTransaction laccessNumber, connRole, 0
 soeObject.F4211ClearWorkFile soeClearWF, ow, connRole, laccessNumber
 'MsgBox ("After F4211ClearWorkFile.")
 Set soeObject = Nothing
 Set soeBeginDoc = Nothing
 Set soeEditLine = Nothing
 Set soeEndDoc = Nothing
 Set ow = Nothing
 connRole.Logoff (laccessNumber)
 Set connRole = Nothing

 Exit Sub

errorhandler:
 GetObjectContext().SetAbort
 connRole.Logoff (laccessNumber)
 Set ow = Nothing
End Sub