I am trying to parse this with JsonConverter.bas but everything i have tried is not working, I am coming to the conclusion that this is not json but i cannot figure else what it is and well how to parse it!
"{
""success"": true,
""delivered"": true,
""contactDetailsRequired"": false,
""message"": ""Signed For by: 29 CARDIFF EARLY MAI"",
""signature"": ""https://webservices.thedx.co.uk/PodImage/ImageHandler.ashx?tn=505012368126"",
""date"": ""08-02-2018"",
""serviceLevelName"": ""Tracked Mail"",
""time"": ""07:30:00"",
""trackedProductName"": ""TMS""
}"
I am trying to get each value as a string or an array which then i will insert on sheet, here is the code I have been playing with,
Dim httpObject As Object
Set httpObject = CreateObject("MSXML2.XMLHTTP")
sURL = "https://www.dxdelivery.com/umbraco/Api/TrackingApi/TrackingData?trackingNumber=505012368126&postcode=&trackingType=0"
sRequest = sURL
httpObject.Open "GET", sRequest, False
httpObject.send
sgetresult = httpObject.responseText
MsgBox (sgetresult)
Sheets("sheet1").Range("A1") = sgetresult
Dim FSO As New FileSystemObject
Dim JsonTS As TextStream
Dim JsonText As String
Dim Parsed As Dictionary
' Read .json file
' Parse json to Dictionary
' "values" is parsed as Collection
' each item in "values" is parsed as Dictionary
Set Parsed = JsonConverter.ParseJson(sgetresult)
MsgBox Parsed("""success""")
Hope you can help,
Thank you.
If the JsonConverter.bas (https://github.com/VBA-tools/VBA-JSON) is properly installed, then the following works for me:
Sub test()
Dim httpObject As Object
Set httpObject = CreateObject("MSXML2.XMLHTTP")
sURL = "https://www.dxdelivery.com/umbraco/Api/TrackingApi/TrackingData?trackingNumber=505012368126&postcode=&trackingType=0"
sRequest = sURL
httpObject.Open "GET", sRequest, False
httpObject.send
sGetResult = httpObject.responseText
Set oJSON = JsonConverter.ParseJson(sGetResult)
MsgBox oJSON("success")
For Each sItem In oJSON
MsgBox sItem & " = " & oJSON(sItem)
Next
End Sub
Related
I was trying to pull SuccessFactors data by VBA.
And I was able to pull data by metadata form.
Yet, when I try to convert this into JSON, I kept getting below error...
Err.Raise 10001, "JSONConverter", json_ParseErrorMessage(JsonString, json_Index, "Expecting '{' or '['")
here is my code...
(I put demo instance for SuccessFactors in here)
Sub GetData()
Dim httpReq As New XMLHTTP60
Dim strURL As String
strURL = "https://api55.sapsf.eu/odata/v2/EmpJob?$top=10"
Set httpReq = CreateObject("MSXML2.XMLHTTP")
httpReq.Open "GET", strURL, False
httpReq.Open "GET", strURL, False, "sfadmin#SFPART066783", "PASSWORD"
httpReq.send
Debug.Print httpReq.responseText
Dim jsonObj As Object
Set jsonObj = JsonConverter.ParseJson(httpReq.responseText)
End Sub
I have been using below code to convert the data from JSON to Excel but below JSON format is not converting into excel and having an error Run time error: Invalid procedure call or argument on the line ws.Cells(r, "C").Value = JSON("sku")
Here is my code that i have been using. I do not know why the error is appearing when it works for other JSON format instead of this one.
Your help will be appreciated.
Dim objRequest As Object
Dim strUrl As String
Dim blnAsync As Boolean
Dim strResponse As String
Dim idno As Long
Dim ws As Worksheet
Dim JSON As Object
Dim lrow As Long
Set ws = Sheet4
lrow = ws.Range("C" & ws.Rows.Count).End(xlUp).Row
Set objRequest = CreateObject("MSXML2.XMLHTTP")
strUrl = "url"
blnAsync = True
With objRequest
.Open "GET", strUrl, blnAsync
.setRequestHeader "Content-Type", "application/json"
.send
While objRequest.readyState <> 4
DoEvents
Wend
strResponse = .ResponseText
End With
Set JSON = ParseJson(strResponse)
' Debug.Print strResponse
r = 2
ws.Cells(r, "C").Value = JSON("sku")
'r = r + 1
I'm not sure if there is a option for this in JSONConverter but as far as I know, it doesn't like to parse JSON string that starts with a collection so I would usually create a key manually so that it will convert properly.
Below example also shows how you can loop through the collection and get the value for sku:
'.... Continue after you post the API...
Dim strResponse As String
strResponse = .responseText
Dim resultDict As Object
Set resultDict = ParseJson("{""result"":" & strResponse & "}")
Dim i As Long
Dim resultNum As Long
resultNum = resultDict("result").Count
For i = 1 To resultNum
Debug.Print resultDict("result")(i)("id")
Debug.Print resultDict("result")(i)("sku")
Debug.Print resultDict("result")(i)("upc")
'Loop through skuList collection
Dim j As Long
For j = 1 To resultDict("result")(i)("skuList").Count
Debug.Print vbTab & resultDict("result")(i)("skuList")(j)("id")
Debug.Print vbTab & resultDict("result")(i)("skuList")(j)("sku")
Debug.Print vbTab & resultDict("result")(i)("skuList")(j)("skuTitle")
Next j
Next i
I am trying to extract data from an API JSON response. Everywhere I read says to use JsonConverter.ParseJson and then you can use the data by doing something like Debug.Print jsonObject("name").
I get a 424 error.
Sub get_request_expansions()
Dim ws As Worksheet
Dim jsonObject As Object
Dim sURL As String
Set request = CreateObject("winhttp.winhttprequest.5.1")
sURL = "https://api.scryfall.com/sets/jmp/"
request.Open "GET", sURL, False
request.send
'----------
Debug.Print request.responseText
Set jsonObject = JsonConverter.ParseJson(request.responseText)
Debug.Print jsonObject("name")
'----------
request.abort
End Sub
I'm trying to extract JSON data into Excel sheet as table by using the following code.
Sub test()
Dim httpObject As Object
Set httpObject = CreateObject("MSXML2.XMLHTTP")
sURL = "https://www.nseindia.com/live_market/dynaContent/live_watch/stock_watch/foSecStockWatch.json"
sRequest = sURL
httpObject.Open "GET", sRequest, False
httpObject.send
sGetResult = httpObject.responseText
Dim oJSON As Object
Set oJSON = JsonConverter.ParseJson(sGetResult)
i = 2
For Each sItem In oJSON
dItemString = oJSON(sItem)("symbol")
sItemValue = oJSON(sItem)("open")
vItemValue = oJSON(sItem)("high")
xItemValue = oJSON(sItem)("low")
Cells(i, 1) = dItemString
Cells(i, 2) = sItemValue
Cells(i, 3) = vItemValue
Cells(i, 4) = xItemValue
i = i + 1
Next
End Sub
However, I'm getting the below error!
Why I'm getting this error? Kindly advise
First of all you need to examine the structure of the JSON response, using any online JSON viewer (e. g. http://jsonviewer.stack.hu/), where you can see that your JSON object contains data array, and several properties with scalar values:
Going further there are objects within data array, each of them contains some properties that can be populated in rows on the worksheet:
Here is VBA example showing how that values could be retrieved. Import JSON.bas module into the VBA project for JSON processing.
Option Explicit
Sub Test()
Dim sJSONString As String
Dim vJSON
Dim sState As String
Dim aData()
Dim aHeader()
Dim vResult
' Retrieve JSON content
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://www.nseindia.com/live_market/dynaContent/live_watch/stock_watch/foSecStockWatch.json", True
.send
Do Until .readyState = 4: DoEvents: Loop
sJSONString = .responseText
End With
' Parse JSON sample
JSON.Parse sJSONString, vJSON, sState
If sState = "Error" Then MsgBox "Invalid JSON": End
' Convert raw JSON to 2d array and output to worksheet #1
JSON.ToArray vJSON("data"), aData, aHeader
With ThisWorkbook.Sheets(1)
.Cells.Delete
.Cells.WrapText = False
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aData
.Columns.AutoFit
End With
MsgBox "Completed"
End Sub
Sub OutputArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
Sub Output2DArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize( _
UBound(aCells, 1) - LBound(aCells, 1) + 1, _
UBound(aCells, 2) - LBound(aCells, 2) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
The output for data array for me is as follows:
BTW, the similar approach applied in other answers.
I pasted your code into a test module and then imported the JsonConverter as an additional module in my empty workbook. The error you're getting is likely because you need to add the "Microsoft Scripting Runtime" library to your workbook. In the VBE go to the Tools-->References... menu and then scroll down and put a check mark next to the library. After doing this, your code parsed the JSON without issue.
However it did fail in your loop.
I highly recommend that you use Option Explicit at the top of your module. The variable types you think you're using (because I see you're attempting to use Hungarian notation) are not the types of the actual data necessarily. My suggestion is to use descriptive names for the variables to avoid confusion. Additionally, you should be looping on the oJSON("data") structure (which is a Collection by the way). Here is my suggestions put into practice:
Option Explicit
Sub test()
Dim httpObject As Object
Set httpObject = CreateObject("MSXML2.XMLHTTP")
Dim sURL As String
sURL = "https://www.nseindia.com/live_market/dynaContent/" & _
"live_watch/stock_watch/foSecStockWatch.json"
Dim sRequest As String
sRequest = sURL
httpObject.Open "GET", sRequest, False
httpObject.send
Dim sGetResult As String
sGetResult = httpObject.responseText
Dim oJSON As Object
Set oJSON = JsonConverter.ParseJson(sGetResult)
Dim i As Long
i = 2
Dim dataItem As Variant
Dim symbolName As String
Dim openValue As Double
Dim highValue As Double
Dim lowValue As Variant
For Each dataItem In oJSON("data")
symbolName = dataItem("symbol")
openValue = dataItem("open")
highValue = dataItem("high")
lowValue = dataItem("low")
Cells(i, 1) = symbolName
Cells(i, 2) = openValue
Cells(i, 3) = highValue
Cells(i, 4) = lowValue
i = i + 1
Next
End Sub
I make a request to a website and paste the JSON response into a single cell.
I get an object required 424 error.
Sub GetJSON()
Dim hReq As Object
Dim JSON As Dictionary
Dim var As Variant
Dim ws As Worksheet
Set ws = Title
'create our URL string and pass the user entered information to it
Dim strUrl As String
strUrl = Range("M24").Value
Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "GET", strUrl, False
.Send
End With
'wrap the response in a JSON root tag "data" to count returned objects
Dim response As String
response = "{""data"":" & hReq.responseText & "}"
Set JSON = JsonConverter.ParseJson(response)
'set array size to accept all returned objects
ReDim var(JSON("data").Count, 1)
Cells(25, 13) = JSON
Erase var
Set var = Nothing
Set hReq = Nothing
Set JSON = Nothing
End Sub
The URL that gives me the response in cell "M24":
https://earthquake.usgs.gov/ws/designmaps/asce7-10.json?latitude=36.497452&longitude=-86.949479&riskCategory=III&siteClass=C&title=Seismic
The code after Qharr's response. I get a run time 0 error even though the error says it ran successfully. Nothing is copied to my cells.
Public Sub GetInfo()
Dim URL As String, json As Object
Dim dict As Object
URL = "https://earthquake.usgs.gov/ws/designmaps/asce7-10.json?latitude=36.497452&longitude=-86.949479&riskCategory=III&siteClass=C&title=Seismic"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
Set json = JsonConverter.ParseJson(.responseText) '<== dictionary
ThisWorkbook.Worksheets("Title").Cells(1, 1) = .responseText
Set dict = json("response")("data")
ws.Cells(13, 27) = "ss: " & dict("ss") & Chr$(10) & "s1: " & dict("s1")
End With
End Sub
I'm not clear what you mean. The entire response can go in a cell as follows.
JSON is an object so you would need Set keyword but you can't set a cell range to the dictionary object - the source of your error.
Option Explicit
Public Sub GetInfo()
Dim URL As String, json As Object
URL = "https://earthquake.usgs.gov/ws/designmaps/asce7-10.json?latitude=36.497452&longitude=-86.949479&riskCategory=III&siteClass=C&title=Seismic"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.send
Set json = JsonConverter.ParseJson(.responseText) '<== dictionary
ThisWorkbook.Worksheets("Sheet1").Cells(1, 1) = .responseText
End With
End Sub
When you use parsejson you are converting to a dictionary object which you need to do something with. There is simply too much data nested inside to write anything readable (if limit not exceeded) into one cell.
Inner dictionary data quickly descends into nested collections. The nested collection count comes from
Dim dict As Object
Set dict = json("response")("data")
Debug.Print "nested collection count = " & dict("sdSpectrum").Count + dict("smSpectrum").Count
To get just s1 and ss values parse them out:
Dim dict As Object
Set dict = json("response")("data")
ws.Cells(1, 2) = "ss: " & dict("ss") & Chr$(10) & "s1: " & dict("s1")
I have figured out the solution to pasting the response text with Excel 2003. Below is my finished code.
Public Sub datagrab()
Dim URL As String
Dim ws As Object
Dim xmlhttp As New MSXML2.XMLHTTP60
URL = Range("M24").Value 'This is the URL I'm requesting from
xmlhttp.Open "GET", URL, False
xmlhttp.Send
Worksheets("Title").Range("M25").Value = xmlhttp.responseText
End Sub