Accounting systems

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