Help with Importing XML or JSON online

Cook13s

New Member
Joined
Dec 7, 2017
Messages
12
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.
 
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 ...
 
Upvote 0

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
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.
 
Upvote 0
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 ?
 
Upvote 0
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 ....
 
Upvote 0
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
 
Upvote 0
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.

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
 
Last edited:
Upvote 0
If there is a problem in getting data, instead of the following line;

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

use this one;

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

or, just this;

Code:
RetVal = W.responseText
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,563
Messages
6,114,329
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top