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