Reading a SAP XML file into Access

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
0 replies

Leave a Reply

Want to join the discussion?
Feel free to contribute!

Leave a Reply