Parsing JSON into Excel but having an Error - json

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

Related

I can't read the Xml data by VBA(selectsinglenode but is nothing)

here is the Xml data
<NewZipCdListResponse>
<cmmMsgHeader>
<requestMsgId/>
<responseMsgId/>
<responseTime>20220526:085103847</responseTime>
<successYN>Y</successYN>
<returnCode>00</returnCode>
<errMsg/>
<totalCount>3</totalCount>
<countPerPage>1</countPerPage>
<totalPage>3</totalPage>
<currentPage>1</currentPage>
</cmmMsgHeader>
<newZipCdList>
<zipNo>11033</zipNo>
<address>경기도 연천군 전곡읍 은전로 80 (전곡리, 연천전곡새마을금고)</address>
<rangeKind/>
</newZipCdList>
</NewZipCdListResponse>
I wanna get it to my excel. But i don't know why I cannot do that.
maybe the error is in sentence, "set nodecell1 = objXml.select/.....".
Because nodecell have notthing and I don't know the reason.
here is part of my code.
Sub tracker()
Dim strURL As String
Dim strResult As String
Dim i As Long
Dim objHttp As New WinHttpRequest
Dim oldTime As Single
For i = 2 To Range("a60000").End(xlUp).Row
strURL = "http://openapi.epost.go.kr/postal/retrieveNewZipCdService/retrieveNewZipCdService/getNewZipCdList?ServiceKey=_____&srchwrd=" & Range("a" & i)
objHttp.Open "GET", strURL, False
objHttp.Send
If objHttp.Status = 200 Then '성공했을 경우(if success)
strResult = objHttp.ResponseText
'XML로 연결(contect XML)
Dim objXml As MSXML2.DOMDocument60
Set objXml = New DOMDocument60
objXml.LoadXML (strResult)
'노드 연결(contect node)
Dim nodeCell1 As IXMLDOMNode
Dim nodeCell2 As IXMLDOMNode
Set nodeCell1 = objXml.SelectSingleNode("/NewZipCdListResponse/newZipCdList/zipNo")
Set nodeCell2 = objXml.SelectSingleNode("/NewZipCdListResponse/newZipCdList/address")
'엑셀에 값 반영(input it to excel)
Cells(i, 2).Value = nodeCell1.Text
Cells(i, 3).Value = nodeCell2.Text
Else
End If
Next
End Sub
This works fine for me:
Sub tracker()
Dim objXml As MSXML2.DOMDocument60
Dim nodeCell1 As IXMLDOMNode
Dim nodeCell2 As IXMLDOMNode
Set objXml = New DOMDocument60
objXml.LoadXML Range("A1").Value 'loading XML from worksheet cell for testing
Set nodeCell1 = objXml.SelectSingleNode("/NewZipCdListResponse/newZipCdList/zipNo")
Set nodeCell2 = objXml.SelectSingleNode("/NewZipCdListResponse/newZipCdList/address")
Range("B1").Value = nodeCell1.Text
Range("C1").Value = nodeCell2.Text
End Sub
Output:

Parsing JSON to Excel using VBA

I'm having some trouble with parsing JSON data in VBA. I have tried all of the examples online but I'm still unable to solve the issue. What I have managed to do is pull the JSON data into excel in the original format using another VBA code that pulled in data from another website. I've pasted the code that works below. It's not very clean and it has some duplication because I was just trying to see if I could pull the data.
All of the attempts I have tried to use VBA to parse the data have failed with a variety of errors depending on the approach I took. I'd be very grateful if someone could give me some advice on the simplest way to parse the data I've managed to pull. All I need is the data in columns which I can then use in other sheets in the worbook. I've attached a picture of the data that I've pulled. I have managed to parse JSON data from another webpage and in the code I included each column heading for the JSON data. For this new webpage, the JSON data is nested and there are loads of unique rows so I've not taken this approach. Many thanks
[Sub JSONPull()
Dim WB As Workbook, ws As Worksheet, ws2 As Worksheet, qtb As QueryTable
Dim FC As String, sDate As String, eDate As String, Dockmasterurl As String, Performance As Worksheet
Set WB = Application.ThisWorkbook
Set ws = WB.Sheets("Control")
FC = ws.Range("B5")
sDate = ws.Range("B14")
eDate = ws.Range("B15")
Dim sJSONString As String
Dim vJSON
Dim sState As String
Dim aData()
Dim aHeader()
Dim vResult
Dockmasterurl = "https://fc-inbound-dock-execution-service-eu-eug1-dub.dub.proxy.amazon.com/appointment/bySearchParams?warehouseId=" & FC & "&clientId=dockmaster&localStartDate=" & sDate & "T00%3A00%3A00&localEndDate=" & eDate & "T08%3A00%3A00&isStartInRange=false&searchResultLevel=FULL"
Set ws2 = Sheets("JSON")
ws2.Cells.ClearContents
Set qtb = ws2.QueryTables.Add("URL;" & Dockmasterurl, ws2.Range("A1"))
With qtb
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = True
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
ws2.Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, textqualifier:=xlDoubleQuote, consecutivedelimiter:=False, comma:=True, trailingminusnumbers:=True
ws2.Range("A:S").EntireColumn.AutoFit
For Each qtb In ws2.QueryTables
qtb.Delete
Next
End Sub][1]
Here is VBA example showing how the JSON sample by the link can be converted to 2D array and output to worksheet. 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()
' Retrieve JSON content
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://pastebin.com/raw/hA2UEDXy", 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 JSON to 2D Array
JSON.ToArray vJSON("AppointmentList"), aData, aHeader
' Output to worksheet #1
Output aHeader, aData, ThisWorkbook.Sheets(1)
MsgBox "Completed"
End Sub
Sub Output(aHeader, aData, oDestWorksheet As Worksheet)
With oDestWorksheet
.Activate
.Cells.Delete
With .Cells(1, 1)
.Resize(1, UBound(aHeader) - LBound(aHeader) + 1).Value = aHeader
.Offset(1, 0).Resize( _
UBound(aData, 1) - LBound(aData, 1) + 1, _
UBound(aData, 2) - LBound(aData, 2) + 1 _
).Value = aData
End With
.Columns.AutoFit
End With
End Sub
The output for me is as follows (click to enlarge):
BTW, the similar approach applied in other answers.

Parsing JSON data into Excel sheet

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

VBA Parsing with Json

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

Unable to fetch data which are in json format from a webpage

After running my vba script for the purpose of parsing data from a webpage I could see that it shows "object required" error. I can see the desired data in the msgbox which is set before the error causing line. As i haven't worked with json format yet, I can't make the execution successful. Any help would be appreciated. Here is what i'm up to:
Sub JsonData()
Dim http As New MSXML2.XMLHTTP60
Dim PostData As String, JSONa As Object, ele As Object
PostData = "region=US&latitude=61.7958256&longitude=-148.8045856&location=Sutton-Alpine%2C%20AK&source=US-STANDALONE&radius=25&pageNumber=1&pageSize=10&sortBy=&industryFilter=340&serviceFilter=550,90"
With http
.Open "GET", "https://proadvisorservice.intuit.com/v1/search?" & PostData, False
.setRequestHeader "Content-Type", "application/json; charset=utf-8"
.setRequestHeader "Accept", "application/json;version=1.1.0"
.send
Set JSONa = JsonConverter.ParseJson(.responseText)
End With
MsgBox http.responseText
For Each ele In JSONa
i = i + 1
Cells(i, 1).Value = ele("firstName")
Cells(i, 2).Value = ele("lastName")
Cells(i, 3).Value = ele("city")
Next ele
End Sub
The search results are VBA.Collection where each itemof this collection contains then another Scripting.Dictionary. Hope what you ask for is the following. HTH
Dim results As VBA.Collection
Set results = JSONa("searchResults")
Dim result As Scripting.Dictionary
For Each result In results
i = i + 1
Cells(i, 1).Value = result("firstName")
Cells(i, 2).Value = result("lastName")
Cells(i, 3).Value = result("city")
Next result