READ json http and return value

S

sal21

Active Member
Joined
Apr 1, 2002
Messages
291
i have this url:

"http://dev.virtualearth.net/REST/v1/Imagery/Map/Road/Routes?wp.0=37,3990,13,6197;3;ARAGONA&wp.1=41,0000,16,8833;9;ADELFIA%20CANNETO&mapsize=640,480&C=IT&mapMetadata=1&key=Ap94-koskdt-HryTYKhaJf5GLnuzjt3uLkl5AyKQnIYw6m6QPmiDIxJSWW_1AJ_1"

the result:

{"authenticationResultCode":"ValidCredentials","brandLogoUri":"http:\/\/dev.virtualearth.net\/Branding\/logo_powered_by.png","copyright":"Copyright © 2020 Microsoft and its suppliers. All rights reserved. This API cannot be accessed and the content and any results may not be used, reproduced or transmitted in any manner without express written permission from Microsoft Corporation.","resourceSets":[{"estimatedTotal":1,"resources":[{"__type":"StaticMapMetadata:http:\/\/schemas.microsoft.com\/search\/local\/ws\/rest\/v1","bbox":[39.0789080970647,5.88867187500001,46.7699684335698,19.92919921875],"imageHeight":"480","imageWidth":"640","mapCenter":{"coordinates":["43.0367758576106","12.919921875"]},"pushpins":[{"anchor":{"x":"145","y":"135"},"bottomRightOffset":{"x":"7","y":"0"},"point":{"coordinates":["44.701745","9.067175"]},"topLeftOffset":{"x":"6","y":"15"}},{"anchor":{"x":"500","y":"365"},"bottomRightOffset":{"x":"7","y":"0"},"point":{"coordinates":["40.999759","16.883314"]},"topLeftOffset":{"x":"6","y":"15"}}],"zoom":"6"}]}],"statusCode":200,"statusDescription":"OK","traceId":"59c2307d4dca4acaa2f3e5918c5f684a|DU00000D6C|0.0.0.1"}

now i need to retrive the info from each coordinates, possible?
Tks
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Sort by date Sort by votes
Use XMLhttp to request the URL and convert the response text into a parsed JSON structure using the JsonConverter.bas module from VBA-JSON:

github.com

GitHub - VBA-tools/VBA-JSON: JSON conversion and parsing for VBA

JSON conversion and parsing for VBA. Contribute to VBA-tools/VBA-JSON development by creating an account on GitHub.
github.com github.com

You must set a reference to Microsoft Scripting Runtime, via Tools > References in the VBA editor, because JsonConverter uses early binding of the Dictionary object.

Here is example code for your URL:

VBA Code: 
Public Sub Extract_JSON_Data()

    Dim httpReq As Object
    Set httpReq = CreateObject("MSXML2.XMLHTTP")

    Dim URL As String
    Dim ParsedJSONdict As Object
   
    URL = "http://dev.virtualearth.net/REST/v1/Imagery/Map/Road/Routes?wp.0=37,3990,13,6197;3;ARAGONA&wp.1=41,0000,16,8833;9;ADELFIA%20CANNETO&mapsize=640,480&C=IT&mapMetadata=1&key=Ap94-koskdt-HryTYKhaJf5GLnuzjt3uLkl5AyKQnIYw6m6QPmiDIxJSWW_1AJ_1"
   
    With httpReq
        .Open "GET", URL, False
        .send
        Set ParsedJSONdict = JsonConverter.ParseJson(.responseText)
    End With
   
    With ThisWorkbook.Worksheets("JSON")
        .Cells.Clear
        JSONToCells ParsedJSONdict, .Range("A1")
    End With
   
End Sub


Private Function JSONToCells(JSONvar As Variant, destCell As Range, Optional ByVal path As String) As Long

    Dim n As Long
    Dim key As Variant
    Dim i As Long

    n = 0

    If varType(JSONvar) = vbObject Then 'Dictionary or Collection
   
        If TypeName(JSONvar) = "Dictionary" Then
            If JSONvar.Count = 0 Then n = 1
            For Each key In JSONvar.keys
                'Debug.Print key
                destCell.Offset(n, 0).Value = key
                n = n + JSONToCells(JSONvar(key), destCell.Offset(n, 1), path & "(""" & key & """)")
            Next
        ElseIf TypeName(JSONvar) = "Collection" Then
            If JSONvar.Count = 0 Then n = 1
            For i = 1 To JSONvar.Count
                'Debug.Print i
                destCell.Offset(n, 0).Value = i
                n = n + JSONToCells(JSONvar(i), destCell.Offset(n, 1), path & "(" & i & ")")
            Next
        End If

    ElseIf varType(JSONvar) >= vbArray Then 'Variant()

        If UBound(JSONvar) = -1 Then n = 1
        For i = 0 To UBound(JSONvar)
            'Debug.Print i
            destCell.Offset(n, 0).Value = i
            n = n + JSONToCells(JSONvar(i), destCell.Offset(n, 1), path & "(" & i & ")")
        Next

    Else

        'Debug.Print JSONvar
        destCell.Offset(n, 0).Value = JSONvar
        CreateComment destCell.Offset(n, 0), path
        n = n + 1

    End If

    JSONToCells = n

End Function


Private Sub CreateComment(cell As Range, commentText As String)
       
    With cell
        If .Comment Is Nothing Then .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=commentText
        .Comment.Shape.TextFrame.AutoSize = True
    End With
   
End Sub
Once you have the structured JSON data in the ParsedJSONdict object, you can extract the required values from it.

The above code calls the JSONToCells function which works with JsonConverter and outputs the parsed JSON object to Excel cells on the "JSON" sheet (which must exist) in a tree layout; the 'leaf' cell of each node is the data value and it contains a comment showing how to reach that data value in the ParsedJSONdict object.

Post back if you need further help to extract the coordinates.
 
Upvote 0
John_w said:
Use XMLhttp to request the URL and convert the response text into a parsed JSON structure using the JsonConverter.bas module from VBA-JSON:

github.com

GitHub - VBA-tools/VBA-JSON: JSON conversion and parsing for VBA

JSON conversion and parsing for VBA. Contribute to VBA-tools/VBA-JSON development by creating an account on GitHub.
github.com github.com

You must set a reference to Microsoft Scripting Runtime, via Tools > References in the VBA editor, because JsonConverter uses early binding of the Dictionary object.

Here is example code for your URL:

VBA Code: 
Public Sub Extract_JSON_Data()

    Dim httpReq As Object
    Set httpReq = CreateObject("MSXML2.XMLHTTP")

    Dim URL As String
    Dim ParsedJSONdict As Object
  
    URL = "http://dev.virtualearth.net/REST/v1/Imagery/Map/Road/Routes?wp.0=37,3990,13,6197;3;ARAGONA&wp.1=41,0000,16,8833;9;ADELFIA%20CANNETO&mapsize=640,480&C=IT&mapMetadata=1&key=Ap94-koskdt-HryTYKhaJf5GLnuzjt3uLkl5AyKQnIYw6m6QPmiDIxJSWW_1AJ_1"
  
    With httpReq
        .Open "GET", URL, False
        .send
        Set ParsedJSONdict = JsonConverter.ParseJson(.responseText)
    End With
  
    With ThisWorkbook.Worksheets("JSON")
        .Cells.Clear
        JSONToCells ParsedJSONdict, .Range("A1")
    End With
  
End Sub


Private Function JSONToCells(JSONvar As Variant, destCell As Range, Optional ByVal path As String) As Long

    Dim n As Long
    Dim key As Variant
    Dim i As Long

    n = 0

    If varType(JSONvar) = vbObject Then 'Dictionary or Collection
  
        If TypeName(JSONvar) = "Dictionary" Then
            If JSONvar.Count = 0 Then n = 1
            For Each key In JSONvar.keys
                'Debug.Print key
                destCell.Offset(n, 0).Value = key
                n = n + JSONToCells(JSONvar(key), destCell.Offset(n, 1), path & "(""" & key & """)")
            Next
        ElseIf TypeName(JSONvar) = "Collection" Then
            If JSONvar.Count = 0 Then n = 1
            For i = 1 To JSONvar.Count
                'Debug.Print i
                destCell.Offset(n, 0).Value = i
                n = n + JSONToCells(JSONvar(i), destCell.Offset(n, 1), path & "(" & i & ")")
            Next
        End If

    ElseIf varType(JSONvar) >= vbArray Then 'Variant()

        If UBound(JSONvar) = -1 Then n = 1
        For i = 0 To UBound(JSONvar)
            'Debug.Print i
            destCell.Offset(n, 0).Value = i
            n = n + JSONToCells(JSONvar(i), destCell.Offset(n, 1), path & "(" & i & ")")
        Next

    Else

        'Debug.Print JSONvar
        destCell.Offset(n, 0).Value = JSONvar
        CreateComment destCell.Offset(n, 0), path
        n = n + 1

    End If

    JSONToCells = n

End Function


Private Sub CreateComment(cell As Range, commentText As String)
      
    With cell
        If .Comment Is Nothing Then .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=commentText
        .Comment.Shape.TextFrame.AutoSize = True
    End With
  
End Sub
Once you have the structured JSON data in the ParsedJSONdict object, you can extract the required values from it.

The above code calls the JSONToCells function which works with JsonConverter and outputs the parsed JSON object to Excel cells on the "JSON" sheet (which must exist) in a tree layout; the 'leaf' cell of each node is the data value and it contains a comment showing how to reach that data value in the ParsedJSONdict object.

Post back if you need further help to extract the coordinates.
Click to expand...
great job!
 
Upvote 0
John_w said:
Use XMLhttp to request the URL and convert the response text into a parsed JSON structure using the JsonConverter.bas module from VBA-JSON:

github.com

GitHub - VBA-tools/VBA-JSON: JSON conversion and parsing for VBA

JSON conversion and parsing for VBA. Contribute to VBA-tools/VBA-JSON development by creating an account on GitHub.
github.com github.com

You must set a reference to Microsoft Scripting Runtime, via Tools > References in the VBA editor, because JsonConverter uses early binding of the Dictionary object.

Here is example code for your URL:

VBA Code: 
Public Sub Extract_JSON_Data()

    Dim httpReq As Object
    Set httpReq = CreateObject("MSXML2.XMLHTTP")

    Dim URL As String
    Dim ParsedJSONdict As Object
 
    URL = "http://dev.virtualearth.net/REST/v1/Imagery/Map/Road/Routes?wp.0=37,3990,13,6197;3;ARAGONA&wp.1=41,0000,16,8833;9;ADELFIA%20CANNETO&mapsize=640,480&C=IT&mapMetadata=1&key=Ap94-koskdt-HryTYKhaJf5GLnuzjt3uLkl5AyKQnIYw6m6QPmiDIxJSWW_1AJ_1"
 
    With httpReq
        .Open "GET", URL, False
        .send
        Set ParsedJSONdict = JsonConverter.ParseJson(.responseText)
    End With
 
    With ThisWorkbook.Worksheets("JSON")
        .Cells.Clear
        JSONToCells ParsedJSONdict, .Range("A1")
    End With
 
End Sub


Private Function JSONToCells(JSONvar As Variant, destCell As Range, Optional ByVal path As String) As Long

    Dim n As Long
    Dim key As Variant
    Dim i As Long

    n = 0

    If varType(JSONvar) = vbObject Then 'Dictionary or Collection
 
        If TypeName(JSONvar) = "Dictionary" Then
            If JSONvar.Count = 0 Then n = 1
            For Each key In JSONvar.keys
                'Debug.Print key
                destCell.Offset(n, 0).Value = key
                n = n + JSONToCells(JSONvar(key), destCell.Offset(n, 1), path & "(""" & key & """)")
            Next
        ElseIf TypeName(JSONvar) = "Collection" Then
            If JSONvar.Count = 0 Then n = 1
            For i = 1 To JSONvar.Count
                'Debug.Print i
                destCell.Offset(n, 0).Value = i
                n = n + JSONToCells(JSONvar(i), destCell.Offset(n, 1), path & "(" & i & ")")
            Next
        End If

    ElseIf varType(JSONvar) >= vbArray Then 'Variant()

        If UBound(JSONvar) = -1 Then n = 1
        For i = 0 To UBound(JSONvar)
            'Debug.Print i
            destCell.Offset(n, 0).Value = i
            n = n + JSONToCells(JSONvar(i), destCell.Offset(n, 1), path & "(" & i & ")")
        Next

    Else

        'Debug.Print JSONvar
        destCell.Offset(n, 0).Value = JSONvar
        CreateComment destCell.Offset(n, 0), path
        n = n + 1

    End If

    JSONToCells = n

End Function


Private Sub CreateComment(cell As Range, commentText As String)
     
    With cell
        If .Comment Is Nothing Then .AddComment
        .Comment.Visible = False
        .Comment.Text Text:=commentText
        .Comment.Shape.TextFrame.AutoSize = True
    End With
 
End Sub
Once you have the structured JSON data in the ParsedJSONdict object, you can extract the required values from it.

The above code calls the JSONToCells function which works with JsonConverter and outputs the parsed JSON object to Excel cells on the "JSON" sheet (which must exist) in a tree layout; the 'leaf' cell of each node is the data value and it contains a comment showing how to reach that data value in the ParsedJSONdict object.

Post back if you need further help to extract the coordinates.
Click to expand...
Hi John, I used this code, it reported the values in the json sheet, now I have to extrapolate only certain values, how to do?
I started a new topic, when you can, read it, please.
 
Last edited:
Upvote 0
Hello John_w,

what needs to be written in addition,into the code before sending the http request with the key (the API to which I send the request requires a key and it has TLS 3.0 protocol
 
Upvote 0
TR07NMI said:
what needs to be written in addition,into the code before sending the http request with the key (the API to which I send the request requires a key and it has TLS 3.0 protocol
Click to expand...
It depends what the API requires. The key might be specified in a request header (with SetRequestHeader) or in the request body (the Send argument). Please start a new thread with details of the API and your attempted code.
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,223,246
Messages
6,170,988
Members
452,373
Latest member
TimReeks

Share this page

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