VBA - Populate Listbox with xml

[Trebor8484]

Hi,

Can someone assist with the code below please.

I am trying to populate a listbox "ListBox1" with 4 columns lastname, sales, country and quarter from an xml file.

There are 56 records stored in my dictionary and each row of the listbox should have 4 items as below.

LastName	Sales	Country	Quarter
Smith	16753​	UK	Qtr 3
Johnson	14808​	USA	Qtr 4
Williams	10644​	UK	Qtr 2
Jones	1390​	USA	Qtr 3
Brown	4865​	USA	Qtr 4
Williams	12438​	UK	Qtr 1
Johnson	9339​	UK	Qtr 2
Smith	18919​	USA	Qtr 3
Jones	9213​	USA	Qtr 4
Jones	7433​	UK	Qtr 1
Brown	3255​	USA	Qtr 2
Williams	14867​	USA	Qtr 3
Williams	19302​	UK	Qtr 4
Smith	9698​	USA	Qtr 1

Private Sub CommandButton1_Click()

    Dim oXMLHTTP As New MSXML2.ServerXMLHTTP60
    Dim sPageHTML As String
    Dim sURL As String
    Dim XmlMapResponse As String
    Dim strXML As String
    Dim XDoc As MSXML2.DOMDocument60
    Dim xNode As MSXML2.IXMLDOMNode
    Dim cNode As MSXML2.IXMLDOMNode
    Dim ChromeLocation As String
    Dim sht As Worksheet
    Dim x, y As Integer
    Dim DictCount As Long
    Dim DictKey As Variant
    Dim Dict As Scripting.Dictionary

    Set sht = ThisWorkbook.Sheets("Sheet1")
    Set Dict = New Scripting.Dictionary

    x = 2
    y = 1
    DictCount = 0

    sht.Cells.Clear
    ChromeLocation = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
    sURL = "https://www.excel-easy.com/examples/files/data-set.xml"

    oXMLHTTP.Open "GET", sURL, False
    oXMLHTTP.send

    If oXMLHTTP.Status <> 200 Then
        MsgBox oXMLHTTP.Status & " - " & oXMLHTTP.statusText
        Exit Sub
    End If

    XmlMapResponse = oXMLHTTP.responseText
    strXML = XmlMapResponse

    Shell (ChromeLocation & " -url " & sURL), vbMaximizedFocus

    Set XDoc = New MSXML2.DOMDocument60

    If Not XDoc.LoadXML(strXML) Then
        Err.Raise XDoc.parseError.ErrorCode, , XDoc.parseError.reason
    End If

    'Select the first record element from the data-set element
    Set xNode = XDoc.SelectSingleNode("data-set/record")
    Debug.Print xNode.Text

    'Select the fourth record element from the data-set element
    Set xNode = XDoc.SelectSingleNode("data-set/record[4]")
    Debug.Print xNode.Text

    'Loop through each record element that is the child of the data-set element
    For Each xNode In XDoc.SelectNodes("data-set/record")
        Debug.Print xNode.Text
    Next xNode

    'Loop through each Country element that is the child of the record element
    'that is the child of the data-set element
    For Each xNode In XDoc.SelectNodes("data-set/record/Country")
        Debug.Print xNode.Text
    Next xNode

    'Loop through each child node of the record elements of the data-set element
    For Each xNode In XDoc.SelectNodes("data-set/record")
        For Each cNode In xNode.ChildNodes
            Debug.Print xNode.Text
            Debug.Print cNode.Text
            DictCount = DictCount + 1
            Dict.Add DictCount, cNode.Text
            'If sht.Cells(1, y).Value = "" Then sht.Cells(1, y).Value = cNode.nodeName
            'sht.Cells(x, y).Value = cNode.Text
            y = y + 1
        Next cNode

        x = x + 1
        y = 1
    Next xNode

    x = 2
    y = 0
    
    For Each DictKey In Dict.Items()
        y = y + 1
        Cells(x, y).Value = DictKey
        [COLOR=rgb(184, 49, 47)]Me.ListBox1.AddItem[/COLOR]
        If y = 4 Then
            x = x + 1
            y = 0
        End If
    Next DictKey

    sht.Columns.AutoFit

End Sub

 

[Trebor8484]

Anyone please?