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.

 

[Cook13s]

No dice, however there's no error now. It looks like from what I am assuming at this point,

On Error Resume Next
     W.Open "GET", URL, False, "YOUR_Username", "YOUR_Password"
     W.send

It's supposed to open a window to request this information from me, correct? It didn't end up happening, maybe the code has changed between the updated version of the Office. I really thank you for trying to help me out, I have a better understanding of VBA now.

 

[Haluk]

Hi again;

I don't know if you have solved your problem. If not, can you try the code below entering your real Username and Password in the code, marked in red color.

Sub Test5()
     Dim W As Object, WshShell As Object, adoStream As Object
     Dim URL As String
     Dim RetVal
     Dim xDoc As Object
     
     URL = "[COLOR=#0000cd][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
     
     W.Open "GET", URL, False
     W.SetCredentials "[COLOR=#ff0000][B]Username[/B][/COLOR]", "[B][COLOR=#ff0000]Password[/COLOR][/B]", 0
     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.responseText, 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

 

[Cook13s]

Hi again, it looks like that didn't work out.

 

[Haluk]

Hi again;

Before giving up, I just want you to try this one as a last option.

If the URL of the site that require you to submit your username and password is different then the URL of the XML file, then we may need to "POST" the credentials to the main site and if it is accepted, then we may go further and get the XML file from the server.

So, just try the below code and see what happens (..... any error messages and so on)

Enter your real data into the code marked with red.

Sub Test6()
     Dim W As Object, WshShell As Object, adoStream As Object
     Dim URL As String
     Dim RetVal
     Dim xDoc As Object
     
     mainURL = "[COLOR=#ff0000][B]https://Your_Main_URL_to_the_Site.com[/B][/COLOR]"
     xmlURL = "[B][COLOR=#ff0000]https://Your_URL_to_XML_File.xml[/COLOR][/B]"
     
     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
     
     W.Open "POST", mainURL, False
     W.SetCredentials "[B][COLOR=#ff0000]Username[/COLOR][/B]", "[B][COLOR=#ff0000]Password[/COLOR][/B]", 0
     W.Send
     
     W.WaitForResponse
     
     If Err Then
         MsgBox Err.Number & vbCrLf & Err.Description
         Exit Sub
     End If
    
     If W.Status = 200 Then
     
        W.Open "GET", xmlURL, False
        W.Send
        
        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.responseText, 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