The task criteria was to load orders from field sales office by adding automation to Excel files or loading XML files into an access database. This allows the client to validate the order entries and ensure all key data is present before attempting to load the orders into Syspro.
This post covers the export of the data from the validated database into Syspro.
To use this code you would need to download and install the free ChilkatXML program see chilkatsoft.com and add a reference to Chilkat XML, DAO 3.6 and Syspro e.Net.
If you any questions on how to use this code please post a question
Function ExportXML()
' this function will use a validated export table of data to create the xml file
'and pass this file to be executed by Syspro
'Structure creted on 3-Apr
Dim xml As New ChilkatXml
Dim HeaderNode As ChilkatXml
Dim OrderNode As ChilkatXml
Dim OrderHeaderNode As ChilkatXml
Dim OrderDetailsNode As ChilkatXml
Dim OrderDetailsStockLineNode As ChilkatXml
Dim OrderDetailsCommentLineNode As ChilkatXml
Dim OrderDetailsMiscChargeLineNode As ChilkatXml
Dim OrderDetailsFreightLineNode As ChilkatXml
Dim tmpOrderNumber, tmpEntityNumber, tmpOrderLine
Dim rst As Recordset
Set HeaderNode = xml.NewChild("TransmissionHeader", "")
Set OrderNode = xml.NewChild("Orders", "")
xml.Tag = "SalesOrders"
'set the header values
HeaderNode.NewChild2 "TransmissionReference", "000003" 'rst!ID 'use the id of the passed recordset
HeaderNode.NewChild2 "SenderCode", ""
HeaderNode.NewChild2 "ReceiverCode", "HO"
HeaderNode.NewChild2 "DatePRepared", Format(Date, "yyyy-mm-dd")
HeaderNode.NewChild2 "TimePrepared", Format(Now(), "hh:nn")
Set rst = CurrentDb.OpenRecordset("qryImportData_Filtered") ' this is a filtered list of the record to upload
If rst.RecordCount = 0 Then
MsgBox "Nothing to Process"
GoTo Exit_Func
Exit Function
Else
rst.MoveFirst
End If
tmpEntityNumber = ""
tmpOrderNumber = ""
tmpOrderLine = 1
'Set OrderHeaderNode = OrderNode.NewChild("OrderHeader", "")
Do While Not rst.EOF
If tmpEntityNumber <> rst!O_Entity Or tmpOrderNumber <> rst!O_Number Then
'Must be a new order - write the header data and fill the static details
Set OrderHeaderNode = OrderNode.NewChild("OrderHeader", "")
Set OrderDetailsNode = OrderNode.NewChild("OrderDetails", "")
tmpEntityNumber = rst!O_Entity
tmpOrderNumber = rst!O_Number
tmpOrderLine = 1
'Add the order header values
OrderHeaderNode.NewChild2 "CustomerPoNumber", rst!O_Number 'get from recordset
OrderHeaderNode.NewChild2 "OrderActionType", tmpOrderActionType 'get from variables
OrderHeaderNode.NewChild2 "NewCustomerPoNumber", ""
OrderHeaderNode.NewChild2 "Supplier", ""
OrderHeaderNode.NewChild2 "Customer", rst!O_Entity
OrderHeaderNode.NewChild2 "OrderDate", Format(Date, "yyyy-mm-dd")
OrderHeaderNode.NewChild2 "InvoiceTerms", ""
OrderHeaderNode.NewChild2 "Currency", ""
OrderHeaderNode.NewChild2 "ShippingInstrs", ""
OrderHeaderNode.NewChild2 "CustomerName", Left(rst!O_ShipName & "", 30)
OrderHeaderNode.NewChild2 "ShipAddress1", Left(rst!O_Ship1 & "", 40)
OrderHeaderNode.NewChild2 "ShipAddress2", Left(rst!O_Ship2 & "", 40)
OrderHeaderNode.NewChild2 "ShipAddress3", Left(rst!O_Ship3 & "", 40)
OrderHeaderNode.NewChild2 "ShipAddress4", Left(rst!O_Ship4 & "", 40)
OrderHeaderNode.NewChild2 "ShipAddress5", Left(rst!O_Ship5 & "", 40)
OrderHeaderNode.NewChild2 "ShipPostalCode", Left(rst!O_Ship6 & "", 9) 'had issues with null values so added the quotes
OrderHeaderNode.NewChild2 "Email", ""
OrderHeaderNode.NewChild2 "OrderDiscPercent1", ""
OrderHeaderNode.NewChild2 "OrderDiscPercent2", ""
OrderHeaderNode.NewChild2 "OrderDiscPercent3", ""
OrderHeaderNode.NewChild2 "Warehouse", "" 'rst!O_Warehouse '
OrderHeaderNode.NewChild2 "SpecialInstrs", ""
OrderHeaderNode.NewChild2 "SalesOrder", ""
OrderHeaderNode.NewChild2 "OrderType", ""
OrderHeaderNode.NewChild2 "MultiShipCode", ""
OrderHeaderNode.NewChild2 "AlternateReference", ""
OrderHeaderNode.NewChild2 "Salesperson", ""
OrderHeaderNode.NewChild2 "Branch", ""
OrderHeaderNode.NewChild2 "Area", rst!O_Area '""
OrderHeaderNode.NewChild2 "RequestedShipDate", ""
OrderHeaderNode.NewChild2 "InvoiceNumberEntered", ""
OrderHeaderNode.NewChild2 "InvoiceDateEntered", ""
OrderHeaderNode.NewChild2 "OrderComments", ""
OrderHeaderNode.NewChild2 "Nationality", ""
OrderHeaderNode.NewChild2 "DeliveryTerms", ""
OrderHeaderNode.NewChild2 "TransactionNature", ""
OrderHeaderNode.NewChild2 "TransportMode", ""
OrderHeaderNode.NewChild2 "ProcessFlag", ""
OrderHeaderNode.NewChild2 "TaxExemptNumber", ""
OrderHeaderNode.NewChild2 "TaxExemptionStatus", ""
OrderHeaderNode.NewChild2 "GstExemptNumber", ""
OrderHeaderNode.NewChild2 "GstExemptionStatus", ""
OrderHeaderNode.NewChild2 "CompanyTaxNumber", ""
OrderHeaderNode.NewChild2 "CancelReasonCode", ""
OrderHeaderNode.NewChild2 "DocumentFormat", ""
OrderHeaderNode.NewChild2 "State", ""
OrderHeaderNode.NewChild2 "CountyZip", ""
OrderHeaderNode.NewChild2 "City", ""
OrderHeaderNode.NewChild2 "eSignature", ""
tmpHonApo = rst!O_HonAffPO
End If
Set OrderDetailsStockLineNode = OrderDetailsNode.NewChild("StockLine", "")
' ad criteria to define the line type in the order import
'get the stock line itmes
OrderDetailsStockLineNode.NewChild2 "CustomerPoLine", tmpOrderLine
tmpOrderLine = tmpOrderLine + 1
OrderDetailsStockLineNode.NewChild2 "LineActionType", tmpLineActionType
OrderDetailsStockLineNode.NewChild2 "LineCancelCode", ""
OrderDetailsStockLineNode.NewChild2 "StockCode", rst!O_Part
OrderDetailsStockLineNode.NewChild2 "StockDescription", "" 'Left(rst!sDescription & "", 30)
OrderDetailsStockLineNode.NewChild2 "Warehouse", rst!O_Warehouse 'tmpDefaultWarehouse
OrderDetailsStockLineNode.NewChild2 "CustomersPartNumber", rst!O_AltPArt &""
OrderDetailsStockLineNode.NewChild2 "OrderQty", rst!O_Qty
OrderDetailsStockLineNode.NewChild2 "OrderUom", rst!stockuom & ""
OrderDetailsStockLineNode.NewChild2 "Price", IIf(tmpLoadPrice, rst!O_Price, "")
OrderDetailsStockLineNode.NewChild2 "PriceUom", rst!stockuom & ""
OrderDetailsStockLineNode.NewChild2 "PriceCode", rst!O_PriceList '""
OrderDetailsStockLineNode.NewChild2 "AlwaysUsePriceEntered", ""
OrderDetailsStockLineNode.NewChild2 "Units", ""
OrderDetailsStockLineNode.NewChild2 "Pieces", ""
OrderDetailsStockLineNode.NewChild2 "ProductClass", rst!productclass & ""
OrderDetailsStockLineNode.NewChild2 "LineDiscPercent1", ""
OrderDetailsStockLineNode.NewChild2 "LineDiscPercent2", ""
OrderDetailsStockLineNode.NewChild2 "LineDiscPercent3", ""
OrderDetailsStockLineNode.NewChild2 "CustRequestDate", ""
OrderDetailsStockLineNode.NewChild2 "CommissionCode", ""
OrderDetailsStockLineNode.NewChild2 "LineShipDate", Format(rst!O_LineShipDate, "yyyy-mm-dd")
OrderDetailsStockLineNode.NewChild2 "LineDiscValue", ""
OrderDetailsStockLineNode.NewChild2 "LineDiscValFlag", ""
OrderDetailsStockLineNode.NewChild2 "OverrideCalculatedDiscount", ""
OrderDetailsStockLineNode.NewChild2 "UserDefined", ""
OrderDetailsStockLineNode.NewChild2 "NonStockedLine", ""
OrderDetailsStockLineNode.NewChild2 "NsProductClass", ""
OrderDetailsStockLineNode.NewChild2 "NsUnitCost", ""
OrderDetailsStockLineNode.NewChild2 "UnitMass", ""
OrderDetailsStockLineNode.NewChild2 "UnitVolume", ""
OrderDetailsStockLineNode.NewChild2 "StockTaxCode", ""
OrderDetailsStockLineNode.NewChild2 "StockNotTaxable", ""
OrderDetailsStockLineNode.NewChild2 "StockFstCode", ""
OrderDetailsStockLineNode.NewChild2 "StockNotFstTaxable", ""
OrderDetailsStockLineNode.NewChild2 "ConfigPrintInv", ""
OrderDetailsStockLineNode.NewChild2 "ConfigPrintDel", ""
OrderDetailsStockLineNode.NewChild2 "ConfigPrintAck", ""
'Set OrderDetailsCommentLineNode = OrderDetailsNode.NewChild("CommentLine", "")
'get the comment lines
'OrderDetailsCommentLineNode.NewChild2 "CustomerPoLine", "2" 'get from recordset
'Set OrderDetailsMiscChargeLineNode = OrderDetailsNode.NewChild("MiscChargeLine", "")
'get the Misc line details
'OrderDetailsMiscChargeLineNode.NewChild2 "CustomerPoLine", "3" 'get from recordset
'Set OrderDetailsFreightLineNode = OrderDetailsNode.NewChild("FreightLine", "")
'get the Freight Line Details
'OrderDetailsFreightLineNode.NewChild2 "CustomerPoLine", "4" 'get from recordset
rst.MoveNext ' goto the next line
Loop
' Save the XML:
Dim success As Long
success = xml.SaveXml("c:XMLSO.xml")
If (success <>1) Then
MsgBox xml.LastErrorText
End If
Exit_Func:
Set rst = Nothing
Set HeaderNode = Nothing
Set OrderNode = Nothing
Set OrderHeaderNode = Nothing
Set OrderDetailsNode = Nothing
Set OrderDetailsStockLineNode = Nothing
Set OrderDetailsCommentLineNode = Nothing
Set OrderDetailsMiscChargeLineNode = Nothing
Set OrderDetailsFreightLineNode = Nothing
End Function
The next stage is to use the file created in ExportXML() to pass to Syspro business objects.
Function OrdPost()
On Error GoTo Errorhandler
Dim XMLout, xmlIn, XMLPar
Dim xml As New ChilkatXml
Dim rec1 As ChilkatXml
Dim rec2 As ChilkatXml
Call ExportXML
Call SysproLogon
Dim EncPost As New Encore.Transaction
XMLPar = "Add the xml parameters here"
'xmlIn = xml.LoadXml("c:xmlso.xml")
Open "c:xmlso.xml" For Input As #1
xmlIn = Input(LOF(1), 1)
Close #1
'xml.LoadXmlFile ("c:XMLSO.xml")
'actually post the order
XMLout = EncPost.Post(Guid, "SORTOI", XMLPar, xmlIn)
xml.LoadXml (XMLout)
xml.SaveXml ("c:SORTOIOUT.xml")
'now see if there have been any errors
Call ReadResults
Exit Function
Errorhandler:
MsgBox Err.Number & " " & Err.Description
End Function
Finally you need to Read the results of the post and update the database
Function ReadResults()
On Error GoTo Errorhandler
Dim XMLout, xmlIn, XMLPar
Dim xml As New ChilkatXml
Dim rec1 As ChilkatXml
Dim rec2 As ChilkatXml
Dim rec3 As ChilkatXml
Dim rec4 As ChilkatXml
Dim rec5 As ChilkatXml
Dim rst As Recordset, tmpReason, tmpSql
Dim tmpMEssage1
Dim tmpMessage2, tmpOrder, tmpStkCode, tmpMessage(20)
Dim x
xml.LoadXMLFile ("c:SORTOIOUT.xml")
'search for status
Set rec4 = xml.SearchForTag(Nothing, "SalesOrder")
tmpMessage(2) = rec4.Content
'mark order processed if we have a sales order number
If Len(tmpMessage(2) & "") > 0 Then
CurrentDb.Execute ("UPDATE tblImportData SET O_Processed = -1 WHERE O_Number=" & Chr(34) & tmpPorder & Chr(34) & " AND O_Entity=" & Chr(34) & tmpPcountry & Chr(34))
End If
If Len(tmpMessage(2) & "") = 0 Then
Set rec4 = xml.SearchForTag(Nothing, "Status")
tmpMessage(1) = rec4.Content
'search for Errormessages
Set rec4 = xml.SearchForTag(Nothing, "ErrorDescription")
tmpMessage(3) = rec4.Content
' Find the first article beginning with M
Set rec1 = xml.SearchForTag(Nothing, "Customer")
tmpMessage(4) = rec1.Content
Debug.Print tmpMessage(4)
Set rec1 = xml.SearchForTag(Nothing, "CustomerPoNumber")
tmpMessage(5) = rec1.Content
Debug.Print tmpMessage(5)
End If
'write the overall status
Set rst = CurrentDb.OpenRecordset("tblResults")
With rst
.AddNew
!R_Customer = tmpPcountry
!R_Order = tmpPorder
!R_StockCode = ""
!R_Error = tmpMessage(1) & " Reason: " & tmpMessage(3)
!R_SYSOrder = tmpMessage(2)
!R_MAster = "Y"
!R_Added = Now()
.Update
End With
Set rst = Nothing
Set rec2 = xml.SearchForTag(rec1, "StockCode")
Do While Not rec2 Is Nothing
tmpMessage(6) = rec2.Content
Debug.Print tmpMessage(6)
Set rec3 = xml.SearchForTag(rec2, "ErrorMessages")
Do While Not rec3 Is Nothing
Set rec4 = rec3.SearchForTag(Nothing, "ErrorDescription")
x = 6
Do While Not rec4 Is Nothing
x = x + 1
tmpMessage(x) = rec4.Content
Debug.Print tmpMessage(x)
'find the next message
Set rec4 = rec3.SearchForTag(rec4, "ErrorDescription")
Loop
Set rec3 = rec2.SearchForTag(rec3, "ErrorMessages")
Loop
'nowWrite the Results if an error occurred
If Len(tmpMessage(4) & "") > 0 Then
Set rst = CurrentDb.OpenRecordset("tblResults")
With rst
Do While x >= 7
.AddNew
!R_Customer = tmpPcountry
!R_Order = tmpPorder
!R_StockCode = tmpMessage(6)
!R_Error = tmpMessage(x)
!R_MAster = "N"
!R_Added = Now()
.Update
tmpMessage(x) = ""
x = x - 1
Loop
End With
Set rst = Nothing
End If
Set rec2 = xml.SearchForTag(rec2, "StockCode")
Loop
'now update syspro results
Call UpdateArea
Exit Function
Errorhandler:
End Function