Help with Importing XML or JSON online

[Cook13s]

It seems I can't find a straight answer anywhere, so I hope someone here is able to answer my question, or at least guide me in the right direction. I'd like to know if there's a way to import specific data from an online source, such as a json or xml file, have it automatically populate the excel worksheet with that specific data and ignore anything else not requested.

So for example, we use a ticket system that is 3rd party but does not have a way of exporting data to an excel worksheet. I discovered however that they do have an xml/json exterior that looks something like this.

JSON: https://imgur.com/6mJPEnv (removed sensitive data)

I was able to import the data and it imports everything as a connection. If I add it as a table, it only imports the top tree, which is a lot more work than just manual copy/paste. I would like to know if we can grab this data as a connection using the Get Data from Web function and then automatically populate cells in a work sheet that looks like this. Only adding the text data into the worksheet below. Mind you, the data vary from ticket to ticket but the functions seen on the left column of the JSON/Excel does not change.

Worksheet: https://imgur.com/oZ7F0zj

Thanks in advance.
I don't think I have a great understanding of VBA in Excel but I have messed with scripting before so if I need to get dirty with code, I can.

 

[Haluk]

It should work .... no way out !

I can't help you because you said that, the link requires an internal account. Otherwise, i could help you.

Have luck ...

 

[Cook13s]

No worries, you were great help. I'll see if I can figure something out and post a solution here later for anyone else to refer to.

 

[Haluk]

Hi again;

Can you navigate to the URL of the XML file manually (MyFile = the URL you used in the code) with Internet Explorer and post a screen-shot here ?

 

[Cook13s]

Sure, here you go.

https://imgur.com/YDRUyAH

 

[Haluk]

Seems everything is OK.

Are you sure that the URL is correct, in the code ?

Maybe, instead of "https" you have written "http" or something like that ....

 

[Haluk]

Another option to see if the URL and the XML table is correct, see the animation i have prepared given in link below.

Just follow the steps shown in the animation with your URL of the XML file.

See below;

https://imgur.com/a/cGOSd

 

[Cook13s]

Yes, I think I need to add a username and password in the code somehow since I use something like this in office365 version of Excel.

https://support.office.com/en-us/ar...cel-2016-881c63c6-37c5-4ca2-b616-59e18d75b4de

 

[Cook13s]

Here's what it looks like.

https://imgur.com/a/ayssy

 

[Haluk]

Well, if username and password are needed to reach the XML file on the net it is clear that I don't have the chance to try my below code.

Also, I am using Office 2010 on Windows 7 and I am not sure if the code will work you if you are running different version of XL on a different Windows platform.

Anyway, give a try to the below code and note that; you have to supply the correct URL, Username and Password in the code.

Sub Test4()
     Dim W As Object, WshShell As Object, adoStream As Object
     Dim URL As String
     Dim RetVal
     Dim xDoc As Object
     
     URL = "[COLOR=#ff0000][B]https://Your_URL_to_XML_File.xml[/B][/COLOR]"
     
     On Error Resume Next
         Set W = CreateObject("winhttp.winhttprequest.5")
         If Err.Number <> 0 Then
             Set W = CreateObject("winhttp.winhttprequest.5.1")
         End If
     On Error GoTo 0
     
     On Error Resume Next
     W.Open "GET", URL, False, "[COLOR=#ff0000][B]YOUR_Username[/B][/COLOR]", "[COLOR=#ff0000][B]YOUR_Password[/B][/COLOR]"
     W.send
     
     W.WaitForResponse
     
     If Err Then
         MsgBox Err.Number & vbCrLf & Err.Description
         Exit Sub
     End If
    
     If W.Status = 200 Then
        Set WshShell = CreateObject("WScript.Shell")
        strDocuments = WshShell.SpecialFolders("MyDocuments")
        
        tempFile = strDocuments & Application.PathSeparator & "Temp.xml"
        If Dir(tempFile) <> "" Then Kill tempFile
'       RetVal = W.responseBody
        RetVal = StrConv(W.responseBody, vbUnicode)

        Set adoStream = CreateObject("ADODB.Stream")
        
        adoStream.Charset = "utf-8"
        adoStream.Type = 2
        
        adoStream.Open
        adoStream.WriteText RetVal
        
        adoStream.SaveToFile tempFile, 2
     End If
     
     Set xDoc = CreateObject("MSXML2.DOMDocument")
     xDoc.async = False
     xDoc.validateOnParse = False
     
     xDoc.Load tempFile
     
     Set MyKey = xDoc.SelectSingleNode("//helpdesk-ticket/requester-name")
     Key1 = MyKey.Text
     
     Set MyKey = xDoc.SelectSingleNode("//helpdesk-ticket/responder-name")
     Key2 = MyKey.Text
     
     Set MyKey = xDoc.SelectSingleNode("//helpdesk-ticket/custom_field/customer_id_number_336006")
     Key3 = MyKey.Text
     
     Set MyKey = xDoc.SelectSingleNode("//helpdesk-ticket/custom_field/invoice_number_336006")
     Key4 = MyKey.Text
     
     Set MyKey = xDoc.SelectSingleNode("//helpdesk-ticket/custom_field/model_336006")
     Key5 = MyKey.Text
     
     Set MyKey = xDoc.SelectSingleNode("//helpdesk-ticket/custom_field/depot_confirmed_shipping_address_336006")
     Key6 = MyKey.Text
     
     Set MyKey = xDoc.SelectSingleNode("//helpdesk-ticket/custom_field/warranty_336006")
     Key7 = MyKey.Text
     
     Set MyKey = xDoc.SelectSingleNode("//helpdesk-ticket/custom_field/billabletest_336006")
     Key8 = MyKey.Text
     
     Set MyKey = xDoc.SelectSingleNode("//helpdesk-ticket/custom_field/depot_shipping_type_336006")
     Key9 = MyKey.Text
     
     Range("A1") = "Requester Name:"
     Range("B1") = Key1
     Range("A2") = "Responder Name:"
     Range("B2") = Key2
     Range("A3") = "customer_id_number_336006:"
     Range("B3") = Key3
     Range("A4") = "invoice_number_336006:"
     Range("B4") = Key4
     Range("A5") = "model_336006:"
     Range("B5") = Key5
     Range("A6") = "depot_confirmed_shipping_address_336006:"
     Range("B6") = Key6
     Range("A7") = "warranty_336006:"
     Range("B7") = Key7
     Range("A8") = "billabletest_336006:"
     Range("B8") = Key8
     Range("A9") = "depot_shipping_type_336006:"
     Range("B9") = Key9
     Range("A:B").Columns.AutoFit
     
     Set MyKey = Nothing
     Set xDoc = Nothing
         
     Set W = Nothing
End Sub

 

[Haluk]

If there is a problem in getting data, instead of the following line;

RetVal = StrConv(W.[COLOR=#ff0000]responseBody[/COLOR], vbUnicode)

use this one;

RetVal = StrConv(W.[COLOR=#ff0000]response[B]Text[/B][/COLOR], vbUnicode)

or, just this;

RetVal = W.responseText