Posts

Posting Sales Orders in Syspro using XML and Business Objects

/1 Comment/in , /by

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

Adding Data from an excel file to Access

/0 Comments/in , /by

I wrote this macro to populate an access database with the contents from a protected spreadsheet that was distributed to users in different countries. The Excel file was used for Sales Order Entry. I have removed sections for security purposes, however this should serve as a good starting point for you to start your own version.

The idea is to ensure that the data integrity before loading the file and then marking the excel file as imported to prevent accidental duplication in the upload.

I have added comments to the code to explain the main sections, If you have any questions leave a comment.

'generic format

Sub XML_LoadXLTemplate()
' ExportData Macro
' Version 1.0 2-Apr-09
' Designed to export data to the xml data store
'-------------------------------------------------
Dim tmpTest As Boolean, myfile, tmpStr, tmpFile, tmpPath, x, tmpCells, tmpCount, tmpShipName, tmpAPO
Dim rst As Recordset, db As Database, tmpCountry, tmpEntity, tmpODate, tmpOrderRef, tmpShip5, tmpShip6
Dim tmpShip1, tmpShip2, tmpShip3, tmpShip4, tmpArea, tmpWH, tmpPriceList, tmpStartSheet, tmpShipDate
Dim tmpFailures, rstStock As Recordset, tmpRequestor
Dim tmpPhone, tmpEmail, tmpAttention, tmpWarranty, tmpCrystal, tmpShipVia, tmpShipViaAccount

'|------------------------------------
'|need to set a reference to DAO , under tools
'|references Microsoft DAO 3.6...
'|--------------------------------------

Set db = OpenDatabase("\serverYouDatabase.mdb")
Set rst = db.OpenRecordset("tblImportData")

tmpTest = True
tmpStr = ""

Application.ScreenUpdating = False
tmpStartSheet = ActiveSheet.Name

Range("I1").Select
' This cell is populated after the data is imported to ensure the user does not accidentally duplicate the load

If ActiveCell.Value = "Data Imported" Then
    If MsgBox("This sheet has already been imported, Import Again ?", vbYesNo + vbDefaultButton2) = vbNo Then
        Exit Sub
    End If
End If

Range("A1").Select

If FoundWS("SheetName") = False Then  ' FOR FUNCTION SEE http://www.ozgrid.com/forum/showthread.php?t=38108
    MsgBox "Cannot find the Order Sheet SheetName"
    Exit Sub
End If

Sheets("SheetName").Select

'now check the control cells
tmpFailures = ""

Range("D6").Select
If Len(ActiveCell.Value & "") = 0 Then
    tmpFailures = tmpFailures & "This Order must Contain the Entity Code at D6" & vbCrLf
End If

Range("D7").Select
If Len(ActiveCell.Value & "") = 0 Then
    tmpFailures = tmpFailures & "No Entity name entered at D7 " & vbCrLf
End If
' you can add as many checks to the integrity of the sheet before starting the load

'now check the order lines
Range("a28").Select
i = 1
Do While i < 86 ' I had max 86 lines to validate
    If ActiveCell.Offset(0, 7).Value > 0 Then
        If Len(ActiveCell.Offset(0, 1).Value & "") = 0 Then
            tmpFailures = tmpFailures & "Order Line #" & i & " No part number entered" & vbCrLf
        End If
    End If
    i = i + 1
    ActiveCell.Offset(1, 0).Select
Loop

If Len(tmpFailures & "") > 0 Then
    MsgBox "Order Validation Failed " & vbCrLf & vbCrLf & tmpFailures
    Exit Sub
End If

'now move to the first line defined by A2

Range("d6").Select

'set the variables

tmpEntity = ActiveCell.Value
tmpCountry = ActiveCell.Offset(1, 0).Value
tmpShipName = ActiveCell.Offset(3, 0).Value
tmpShip1 = ActiveCell.Offset(4, 0).Value
tmpShip2 = ActiveCell.Offset(5, 0).Value
tmpShip3 = ActiveCell.Offset(6, 0).Value
tmpShip4 = ActiveCell.Offset(7, 0).Value
tmpShip5 = ActiveCell.Offset(8, 0).Value
tmpShip6 = ActiveCell.Offset(9, 0).Value
tmpAttention = ActiveCell.Offset(10, 0).Value
tmpPhone = ActiveCell.Offset(11, 0).Value
tmpEmail = ActiveCell.Offset(12, 0).Value

Range("A28").Select
tmpCells = 28

'move to the start
Cells(tmpCells, 1).Select

'check the value in a1 & h1 is numeric
Do While tmpCount < 86
    If ActiveCell.Offset(0, 7).Value > 0 Then
        'Add the contents to the database
        With rst
            .AddNew
            !O_Entity = tmpEntity
            !O_Date = tmpODate
            !O_Part = ActiveCell.Offset(0, 1).Value
            !O_PartOrg = ActiveCell.Offset(0, 1).Value
            '!O_AltPart = ActiveCell.Offset(0, 2).Value
            !O_Desc = Left(ActiveCell.Offset(0, 3).Value, 200)
            !O_qty = ActiveCell.Offset(0, 7).Value
            !O_price = ActiveCell.Offset(0, 9).Value
            !O_Price2 = 0 'ActiveCell.Offset(0, 9).Value
            !O_Extended = !O_qty * !O_price 'ActiveCell.Offset(0, 7).Value
            !O_ImpDate = Now()
            !O_LineShipDate = IIf(Len(ActiveCell.Offset(0, 7).Value & "") = 0, tmpShipDate, ActiveCell.Offset(0, 7).Value)
            !O_OrderDate = tmpODate
            !O_Ship1 = tmpShip1
            !O_Ship2 = tmpShip2
            !O_Ship3 = tmpShip3
            !O_Ship4 = tmpShip4
            !O_Ship5 = tmpShip5
            !O_Ship6 = Left(tmpShip6, 9)
            !O_ShipName = tmpShipName
            !O_Phone = tmpPhone
            !O_EmailAddress = tmpEmail
            !O_Crystalid = tmpCrystal
            !O_Warranty = tmpWarranty
            !O_ShipVia = tmpShipVia & " " & tmpShipViaAccount
            !O_Requestor = tmpRequestor
            !O_Attention = tmpAttention
            !O_Text = 1
            !O_Warehouse = ""
            !O_Number = tmpOrderRef & "-" & !O_Warehouse

            Set rstStock = Nothing

            !O_PriceList = "A"

            .Update
        End With
    End If
    ActiveCell.Offset(1, 0).Select
    tmpCount = tmpCount + 1
Loop

MsgBox "Database updated"

End Sub

Using Vlookup in Excel files

/0 Comments/in /by

excelisna1When using the Vlookup or HLookup functions in Excel you will sometimes have #N/A in the cell display as the value cannot be found.

The normal syntax a user would enter in B9 would be VLOOKUP(A9,$A$2:$C$4,2,FALSE) to lookup the value of A9 in the list A2:C4, because the item exists the function returns the value.

In cell B10 the part BD12 does not exist and you get the error #N/A, replace the cell formula with IF(ISNA(VLOOKUP(A14,$A$2:$C$4,2,FALSE)),”None Found”,VLOOKUP(A14,$A$2:$C$4,2,FALSE)) as shown in B14.

In this case I have entered “Not Found” if the value does not exist and in C14  I entered 0.