SAP BOM Upload File

/0 Comments/in , /by

SAP BOM Upload File
To load a BOM into SAP we needed to create a XML file with a hierarchy of the BOM.

To start this project in Access you will need to set a reference to ChilkatXML and have a recordset for the BOM items.

Function Make_SAP_XML()

Dim xml As New ChilkatXml
Dim MT_TPC_BOM As ChilkatXml
Dim ProductHeader As ChilkatXml
Dim Systems As ChilkatXml
Dim System As ChilkatXml
Dim SystemItems As ChilkatXml
Dim SystemItem As ChilkatXml
Dim ATOComponents As ChilkatXml
Dim ATOComponent As ChilkatXml

Dim rst As Recordset
Dim tmpSystemLine As Integer
Dim tmpSystem As String, tmpOrder
Dim tmpItemNo As Integer, tmpOrderLine As Integer

xml.Tag = "MT_TPC_BOM"
xml.AddAttribute "xmlns:nr1", "http://siebel.com/contract_to_order"

Set ProductHeader = xml.NewChild("ProductHeader", "")

'set the header values
ProductHeader.NewChild2 "ConfigSource", "TPC"
ProductHeader.NewChild2 "TPCVersion", "7.3k"
ProductHeader.NewChild2 "TPCInternalDate", Format(Date, "mm/dd/yyyy")
ProductHeader.NewChild2 "TPCEngInfoDate", Format(Date, "mm/dd/yyyy")
ProductHeader.NewChild2 "TPCEngInfoFileVersion", "1.0"
ProductHeader.NewChild2 "CommerciallyComplete", "Y"
ProductHeader.NewChild2 "CurrencyCode", "EUR"

Set Systems = ProductHeader.NewChild("Systems", "")

Set rst = CurrentDb.OpenRecordset("tblBOM_Records")
If rst.RecordCount = 0 Then
    MsgBox "Nothing to Process"
    GoTo Exit_Func
    Exit Function
Else
    rst.MoveFirst
End If

tmpSystemLine = 0
tmpSystem = ""
Do While Not rst.EOF

    If tmpOrder <> rst![Order Number] Then  ' new section
        tmpOrderLine = 1

        tmpItemNo = 1
        Set System = Systems.NewChild("System", "")
        System.NewChild2 "SystemNumber", tmpSystemLine
        System.NewChild2 "SystemName", "SYSTEM_ASSY"
        System.NewChild2 "SystemIDNumber", rst![Order Number] & "." & tmpSystemLine
        System.NewChild2 "Quantity", "1"
            Set SystemItems = System.NewChild("SystemItems", "")

    End If

    If tmpSystem <> rst![Lot_code_Sap] Then
        tmpSystemLine = tmpSystemLine + 1
        Set SystemItem = SystemItems.NewChild("SystemItem", "")

        SystemItem.NewChild2 "OriginalItemNumber", tmpOrderLine & "." & tmpSystemLine
        SystemItem.NewChild2 "Product", rst![Lot_code_Sap]
        SystemItem.NewChild2 "Description", rst![Order Number]
        SystemItem.NewChild2 "Quantity", 1

        Set ATOComponents = SystemItem.NewChild("ATOComponents", "")
        tmpItemNo = 1

    End If

                    Set ATOComponent = ATOComponents.NewChild("ATOComponent", "")

                    ATOComponent.NewChild2 "ATOItemNumber", tmpOrderLine & "." & tmpSystemLine & "." & tmpItemNo
                    ATOComponent.NewChild2 "Product", rst!Product
                    ATOComponent.NewChild2 "Description", rst![Product type]
                    ATOComponent.NewChild2 "Quantity", rst!Qty
                    ATOComponent.NewChild2 "UnitCost", "0"

        tmpOrder = rst![Order Number]
        tmpSystem = rst![Lot_code_Sap]

        tmpItemNo = tmpItemNo + 1

rst.MoveNext ' goto the next line

Loop

'  Save the XML:
Dim success As Long
success = xml.SaveXml("c:SAP_XML_Test.xml")
If (success <> 1) Then
    MsgBox xml.LastErrorText
End If

Exit_Func:
Set rst = Nothing
Set ProductHeader = Nothing
Set Systems = Nothing
Set System = Nothing
Set SystemItems = Nothing
Set ATOComponents = Nothing
Set ATOComponent = Nothing

End Function

Reading a SAP XML file into Access

/0 Comments/in , /by

I use a free product call chilkatxml from chilkatsoft.com, The site has loads of samples but initially I found it difficult to iteriate through the record loops in the xml file.  I have detailed the code I used to load XML orders into an access database.

The first phase is to read the file into an array and the second phase will post that array into an access database. This is similar to theExcel to Access sample but I am using an array to store the data.

Dim xml As ChilkatXml
Dim rec1 As ChilkatXml, rec0 As ChilkatXml
Dim tmpLines(500, 10), i As Integer, tmpCount As Integer ' change the array depth if needed
Dim tmpHeader(25) ' change to the number of headers filds you have
Dim rst As Recordset, rstStock As Recordset
Dim x As Integer

' Load the input document.
Set xml = New ChilkatXml
xml.LoadXMLFile tmpFile ' tmpfile is the XML file passed to this function

'Header
Set rec1 = xml.FindChild("Header")
    If (rec1.FindChild2("OrderNumber") = 1) Then
        tmpHeader(1) = rec1.Content
        rec1.GetParent2
    End If
    If (rec1.FindChild2("CreationDate") = 1) Then
        tmpHeader(2) = rec1.Content
        rec1.GetParent2
    End If
    If (rec1.FindChild2("CompanyCode") = 1) Then
        tmpHeader(3) = Right("000" & rec1.Content, 3)
        rec1.GetParent2
    End If

'ship address
Set rec1 = xml.FindChild("Partners")
    If (rec1.FindChild2("Identifier") = 1) Then
        tmpHeader(4) = rec1.Content
        rec1.GetParent2
    End If
    If (rec1.FindChild2("Name1") = 1) Then
        tmpHeader(5) = rec1.Content
        rec1.GetParent2
    End If
    If (rec1.FindChild2("Name2") = 1) Then
        tmpHeader(6) = rec1.Content
        rec1.GetParent2
    End If
    If (rec1.FindChild2("Street") = 1) Then
        tmpHeader(7) = rec1.Content
        rec1.GetParent2
    End If

    If (rec1.FindChild2("PostCode") = 1) Then
        tmpHeader(8) = rec1.Content
        rec1.GetParent2
    End If
    If (rec1.FindChild2("CountryCode") = 1) Then
        tmpHeader(9) = rec1.Content
        rec1.GetParent2
    End If

    If (rec1.FindChild2("City") = 1) Then
        tmpHeader(10) = rec1.Content
        rec1.GetParent2
    End If

Set rec1 = xml.FindChild("Items")

If (rec1.FirstChild2() = 0) Then
    Set rec1 = Nothing
End If

Set rec0 = rec1.GetParent()

i = 1
Do While Not (rec0 Is Nothing)

    If (rec0.FindChild2("Material") = 1) Then
        tmpLines(i, 1) = rec0.Content
        rec0.GetParent2
    End If

    If (rec0.FindChild2("Description") = 1) Then
        tmpLines(i, 2) = rec0.Content
        rec0.GetParent2
    End If

    If (rec0.FindChild2("Quantity") = 1) Then
        tmpLines(i, 3) = rec0.Content
        rec0.GetParent2
    End If

    If (rec0.FindChild2("DeliveryDate") = 1) Then
        tmpLines(i, 4) = rec0.Content
        rec0.GetParent2
    End If

    If (rec0.FindChild2("PricePerUnit") = 1) Then
        tmpLines(i, 5) = rec0.Content
        rec0.GetParent2
    End If

    If (rec0.FindChild2("ItemText") = 1) Then
        tmpLines(i, 6) = "" & rec0.Content
        rec0.GetParent2
    End If

    If (rec0.FindChild2("InfoRecordPOText") = 1) Then
        tmpLines(i, 7) = "" & rec0.Content
        rec0.GetParent2
    End If

    If (rec0.FindChild2("MaterialPOText ") = 1) Then
        tmpLines(i, 8) = "" & rec0.Content
        rec0.GetParent2
    End If

    If (rec0.FindChild2("DeliveryText") = 1) Then
        tmpLines(i, 9) = "" & rec0.Content
        rec0.GetParent2
    End If

    'now check for vendor material number
    If (rec0.FindChild2("VendorMaterialNumber") = 1) Then
        tmpLines(i, 10) = "" & rec0.Content
        rec0.GetParent2
    End If

    ' Move to the next sibling. The internal reference within node is updated
    ' to the node's next sibling. If no siblings remain, it returns 0.
    If (rec0.NextSibling2() = 0) Then
        Set rec0 = Nothing
    End If

    i = i + 1

Loop

' now write the data into the tblImport
Set rst = CurrentDb.OpenRecordset("tblImportData")

tmpCount = 0
x = 1
Do While Len(tmpLines(x, 2) & "") > 0
    rst.AddNew
    'rst!O_Number = tmpHeader(1)
    rst!O_Entity = tmpHeader(3)
    rst!O_Date = DateSerial(Left(tmpHeader(2), 4), Val(Left(Right(tmpHeader(2), 4), 2)), Val(Right(tmpHeader(2), 2)))
    If Len(tmpLines(x, 1) & "") > 0 Then
        rst!O_Part = tmpLines(x, 1)
    Else
        'try the vendor material number
        rst!O_Part = tmpLines(x, 10)
    End If
    'rst!O_AltPArt = tmpLines(x, 1)
    rst!O_PartOrg = tmpLines(x, 1)
    rst!O_Desc = tmpLines(x, 2)
    rst!O_Qty = tmpLines(x, 3)
    rst!O_Price = tmpLines(x, 5)
    rst!O_Price2 = tmpLines(x, 5)
    rst!O_Extended = Val(Nz(tmpLines(x, 5), 0)) * Val(Nz(tmpLines(x, 3), 0))
    rst!O_ImpDate = Date
    rst!O_ShipName = tmpHeader(5)
    rst!O_Ship1 = tmpHeader(6)
    rst!O_Ship2 = tmpHeader(7)
    rst!O_Ship3 = tmpHeader(8)
    rst!O_Ship4 = tmpHeader(9)
    rst!O_Ship5 = tmpHeader(10)
    'rst!O_Ship6=""
    rst!O_Processed = 0
    rst!O_Failed = 0
    rst!O_Validated = 0
    rst!O_Disc = 0
    rst!O_Number = tmpHeader(1) & "-" & rst!O_Warehouse
    Set rstStock = Nothing

    rst!O_PriceList = "A"
    'rst!O_FailReason
    'rst!O_ORder
    'rst!O_Master
    rst!O_LineShipDate = DateSerial(Left(tmpLines(x, 4), 4), Val(Left(Right(tmpLines(x, 4), 4), 2)), Val(Right(tmpLines(x, 4), 2)))
    'rst!O_OrderDate
    rst!O_Inactive = 0
    rst!O_Text = tmpLines(x, 6) & vbCrLf & tmpLines(x, 7) & vbCrLf & tmpLines(x, 8) & vbCrLf & tmpLines(x, 9) & vbCrLf
    rst.Update
    tmpCount = tmpCount + 1
    x = x + 1
Loop
If tmpCount > 0 Then
    MsgBox "Order Loaded"
Else
    MsgBox "No order lines loaded - check XML File"
End If

End Function