Load Accounting Trade via Excel - Implementation Details

The main method 'LoadData' is called on clicking SUBMIT button. It initiates construction of the XML document and the loading process:

Sub LoadData()
    Dim ServerURL As String
    Dim Login As String
    Dim Pass As String
    Dim composedObject As String
    ServerURL = Range("B5").Text
    Login = Range("B6").Text
    Pass = ActiveSheet.TextBox1.Text
    composedObject = ComposeXML().XML
    If Login <> "" And Pass <> "" Then
        LoadAndRetrieveTSR ServerURL, Login, Pass, composedObject
    Else
        MsgBox "Invalid authorization!"
    End If
  End Sub

It calls the 'ComposeXML' function to compose an XML document, based on the filled fields of the AccountingTrade objects:

'Composes an XML documents based on the non-empty fields of the hierarchal representation of the AccountingTrade object
  Function ComposeXML() As MSXML2.DOMDocument
    'A document to compose
    Dim document As MSXML2.DOMDocument
    Set document = New MSXML2.DOMDocument
    Dim mainNode As MSXML2.IXMLDOMNode
    Set mainNode = document.createElement("accountingTrade")
    document.appendChild mainNode
    'Add identifiers
    Dim tempNode As MSXML2.IXMLDOMNode
    Set tempNode = document.createElement("objectType")
    tempNode.appendChild document.createTextNode("AccountingTrade")
    mainNode.appendChild tempNode
    Set tempNode = document.createElement("objectId")
    tempNode.appendChild document.createTextNode("AccountingTrade")
    mainNode.appendChild tempNode
    Set tempNode = document.createElement("objectDescription")
    tempNode.appendChild document.createTextNode("ACCOUNTING")
    mainNode.appendChild tempNode
   
    Dim mainSheet As Object
    Set mainSheet = ActiveWorkbook.Sheets(1)
    Dim lastFilterRow As Long
    lastFilterRow = mainSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Dim curPath As String
    curPath = ""
    Dim i As Integer
    For i = 15 To lastFilterRow - 1
        Dim curName As String
        curName = mainSheet.Cells(i, 1)
        If StrComp(Mid(curName, 1, 2), "</", vbTextCompare) = 0 Then
            curPath = Mid(curPath, 1, InStrRev(curPath, "/", -1, vbTextCompare) - 1)
        Else
            If StrComp(Mid(curName, 1, 1), "<", vbTextCompare) = 0 Then
                curPath = curPath & "/" & Mid(curName, 2, Len(curName) - 2)
            Else
                If Len(curName) > 0 And Len(mainSheet.Cells(i, 2)) > 0 Then
                    Dim curValue As String
                    curValue = mainSheet.Cells(i, 2)
                    InsertNodeIntoDocument document, curPath & "/" & curName, curValue
                End If
            End If
        End If
    Next i
    Set ComposeXML = document
  End Function

Each created node is inserted using its path from document's root, a name and a value, if the value is not empty, by means of the 'InsertNodeIntoDocument' method:

Sub InsertNodeIntoDocument(doc As MSXML2.DOMDocument, path As String, value As String)
    Dim PathParts() As String
    PathParts = Split(path, "/", -1, vbTextCompare)
    Dim curPos As MSXML2.IXMLDOMElement
    Set curPos = doc.FirstChild
    Dim i As Integer
    Dim lastElemInd As Integer
    lastElemInd = UBound(PathParts)
    For i = 1 To lastElemInd - 1
        Dim list As collection
        Set list = getImmediateChildrenByName(curPos, PathParts(i))
        If list.Count > 0 Then
            Set curPos = list.Item(1)
        Else
            Dim newNode As MSXML2.IXMLDOMElement
            Set newNode = doc.createElement(PathParts(i))
            curPos.appendChild newNode
            Set curPos = newNode
        End If
    Next i
    Set newNode = doc.createElement(PathParts(lastElemInd))
    curPos.appendChild newNode
    Set curPos = newNode
    Dim valueNode As MSXML2.IXMLDOMText
    Set valueNode = doc.createTextNode(value)
    curPos.appendChild valueNode
  End Sub

'getImmediateChildrenByName' function is used to get immediate child nodes of the specified node, with a specified name:

Function getImmediateChildrenByName(elem As MSXML2.IXMLDOMElement, name As String) As collection
    Dim res As collection
    Set res = New collection
    Dim list As MSXML2.IXMLDOMNodeList
    Set list = elem.ChildNodes
    Dim length As Integer
    length = list.length
    Dim i As Integer
    For i = 0 To length - 1
        If list.Item(i).NodeType = NODE_ELEMENT And StrComp(list.Item(i).nodeName, name, vbTextCompare) = 0 Then
            res.Add list.Item(i)
        End If
    Next i
    Set getImmediateChildrenByName = res
  End Function

After an XML document is composed, the 'LoadAndRetrieveTSR' method is called to initiate loading process and to retrieve the TSR:

Sub LoadAndRetrieveTSR(url As String, Login As String, Pass As String, composedObject As String)
    Dim sEnv As String
    Dim sRTR As String
    sRTR = "<EagleML xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xsi:type=""LoadAccounting"" eaglemlVersion=""2-0"" actualBuild=""1"" xmlns=""http://www.eagleinvsys.com/2011/EagleML-2-0"">"
    sRTR = sRTR & "<header xmlns=""http://www.eagleinvsys.com/2011/EagleML-2-0"">"
    sRTR = sRTR & "<messageId>" & Format(Now(), "yyyymmddThhmmss") & "</messageId>"
    sRTR = sRTR & "<sentBy>http://client.com</sentBy>"
    sRTR = sRTR & "<sendTo>http://www.eagleinvsys.com/eagle_ml-2-0_default_cm_control_message</sendTo>"
    sRTR = sRTR & "</header>"
    sRTR = sRTR & "<taskIdentifier>"
    sRTR = sRTR & "<correlationId>" & Format(Now(), "yyyymmddThhmmss") & "</correlationId>"
    sRTR = sRTR & "<businessTaskId>LoadAccountingTrade</businessTaskId>"
    sRTR = sRTR & "</taskIdentifier>"
    sRTR = sRTR & "<taskTypeEnum>LOAD</taskTypeEnum>"
    sRTR = sRTR & "<synchronousExecution>yes</synchronousExecution>"
    sRTR = sRTR & "<accountingTransaction>"
    sRTR = sRTR & composedObject
    sRTR = sRTR & "</accountingTransaction>"
    sRTR = sRTR & "</EagleML>"
   
    sEnv = "<?xml version=""1.0"" encoding=""utf-8""?>"
    sEnv = sEnv & "<s:Envelope xmlns:s=""http://schemas.xmlsoap.org/soap/envelope/"">"
    sEnv = sEnv & " <s:Body xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"">"
    sEnv = sEnv & " <accountingTransactionMessage>"
    sEnv = sEnv & sRTR
    sEnv = sEnv & " </accountingTransactionMessage>"
    sEnv = sEnv & " </s:Body>"
    sEnv = sEnv & "</s:Envelope>"
   
    ContinueLoad sEnv, url, Login, Pass
  End Sub

This method creates a SOAP message to initiate a load task of an AccountingTrade object, which is then sent to the web service of the specified region by the 'ContinueLoad' method:

Sub ContinueLoad(data As String, url As String, Login As String, Pass As String)
    Dim StrXML As String
    Dim DirPathToXML As String
    Dim xmlHtp As Object
    Set xmlHtp = CreateObject("Microsoft.XmlHttp")
    Dim xDoc As MSXML2.DOMDocument
    Set xDoc = New MSXML2.DOMDocument
    DirPathToXML = CurDir() & "\tsr.xml"
   
    With xmlHtp
        .Open "POST", url & "/EagleMLWebService20", False, Login, Pass
        .setRequestHeader "Content-Type", "text/xml; charset=utf-8"
        .setRequestHeader "Host", Replace(Replace(url, "http://", ""), "https://", "")
        .setRequestHeader "Content-Encoding", "gzip, deflate"
        .setRequestHeader "soapAction", "/EagleMLWebService/LoadAccounting"
        .send "" & data
    xDoc.LoadXML .responseText
    End With
           
    Shell "cmd.exe /c cd. > " & DirPathToXML
   
    Open DirPathToXML For Output As #1
    Print #1, xDoc.XML
    Reset
    ImportXMLToList DirPathToXML
   
    Set xmlHtp = Nothing
    Set xDoc = Nothing
  End Sub

This method sends a composed SOAP message to the web service and retrieves the TSR message, which is then imported to the table representation and is added to the TSR sheet of the workbook by the 'ImportXMLToList' method:

Sub ImportXMLtoList(PathToXML As String)
     Dim wb As Workbook
     Dim currentBook As Workbook
     Set currentBook = ActiveWorkbook
     Application.ScreenUpdating = False
     Application.DisplayAlerts = False
     Set wb = Workbooks.OpenXML(Filename:=PathToXML, LoadOption:=xlXmlLoadImportToList)
     Application.DisplayAlerts = True
     Dim tsrSheet As Object
     On Error Resume Next
     Set tsrSheet = currentBook.Sheets("TSR")
     If tsrSheet Is Nothing Then
        Set tsrSheet = currentBook.Sheets.Add(After:=currentBook.Sheets(currentBook.Sheets.Count))
        tsrSheet.name = "TSR"
     Else
        tsrSheet.Cells.Clear
     End If
     wb.Sheets(1).UsedRange.Copy tsrSheet.Range("A1")
     wb.Close False
     tsrSheet.Activate
    
     With ActiveSheet.UsedRange
        ActiveSheet.Rows(.Rows.Count).Delete
     End With
    
     Application.ScreenUpdating = True
  End Sub