Option Explicit

Public Sub readXML()
    Dim cel As Range
    Dim filename As String
    Dim elements  As MSXML2.IXMLDOMNodeList

    Dim element As MSXML2.IXMLDOMNode
    Dim contents As String
   
    Dim sh As Worksheet
    Dim rowData As Long
    Dim xmlDoc As New MSXML2.DOMDocument60
    Dim fso As New FileSystemObject
   
    rowData = 1
   
    Set cel = ActiveCell
    filename = Cells(1, 1).Value & cel.Value
   
    If Not fso.FileExists(filename) Then
        Debug.Assert False
    End If
   
    contents = readFileBinary(filename)
   
    'contents = Replace(contents, "encoding='UTF-8'", "")
    Call xmlDoc.LoadXML(contents)
    If Not xmlDoc.parseError Is Nothing Then
        Debug.Print xmlDoc.parseError.reason
        Debug.Print xmlDoc.parseError.line
    End If
    Set sh = Worksheets.Add

    Call iterateNode(xmlDoc.DocumentElement, sh, 1)
    Set xmlDoc = Nothing
End Sub

Public Sub iterateNode(node As MSXML2.IXMLDOMNode, sh As Worksheet, row As Integer)
    Dim childNode As MSXML2.IXMLDOMNode
    Dim length As Integer
    Dim index As Integer
   
    If node.ChildNodes.length = 0 Then
        Exit Sub
    End If
   
    If node.BaseName = "jdbc-system-resource" Then
        row = row + 1
    End If
   
    If node.ParentNode.BaseName = "jdbc-system-resource" Then
        If Application.WorksheetFunction.CountIf(sh.Rows(1), node.BaseName) > 0 Then
            index = Application.WorksheetFunction.Match(node.BaseName, sh.Rows(1), False)
        Else
            index = Application.WorksheetFunction.CountA(sh.Rows(1))
            sh.Cells(1, index + 1).Value = node.BaseName
            index = index + 1
        End If
       
        sh.Cells(row, index).Value = node.text
    End If
   
    For length = 0 To node.ChildNodes.length - 1
        Set childNode = node.ChildNodes(length)
        Call iterateNode(childNode, sh, row)
    Next
End Sub

'MSXML2.DOMDocument60