Public Sub IMPORTMESTER()
Dim xTOK As String
Dim URL As String
Dim httpREQ As Object
Dim JSON As Object
Dim xLINE As Variant
xTOK = "bdj62bzknriy3dd9g561on2xl2"
URL = "https://api.smartsheet.com/2.0/sheets/7352150637471620"
Set httpREQ = CreateObject("MSXML2.XMLHTTP.6.0")
With httpREQ
.Open "GET", URL, False
.setRequestHeader "Authorization", "Bearer " & xTOK
.setRequestHeader "Content-Type", "application/json"
.Send
End With
xLINE = httpREQ.ResponseText
MsgBox ("Complete!")
End Sub
So, Ive returned data I need, but I tried several methods to parse it and paste in excel, but without success. Here is the part of responsetext:
"cells":[{"columnId":2400415921792900,"value":"MWP08","displayValue":"MWP08"},{"columnId":6904015549163396,"value":"A-WP-80301D5D10C00","displayValue":"A-WP-80301D5D10C00"},{"columnId":1274516014950276,"value":"MWP0830W27V50KD","displayValue":"MWP0830W27V50KD"},{"columnId":5778115642320772,"value":"WP08 30W,120-277VAC,Ra70 5000K Clear lens,Dark bronze","displayValue":"WP08 30W,120-277VAC,Ra70 5000K Clear lens,Dark bronze"},{"columnId":3526315828635524,"value":"image002.png","displayValue":"image002.png","formula":"=SYS_CELLIMAGE(\"image002.png\",\"vDOY-InMRamvhitNGotKzb\",35,52,\"image.png\")","image":{"id":"vDOY-InMRamvhitNGotKzb","height":35,"width":52,"altText":"image002.png"}},{"columnId":8029915456006020},{"columnId":711566061528964,"value":1884.0,"displayValue":"1884","linkInFromCell":{"status":"INACCESSIBLE","sheetId":4533800614029188,"rowId":null,"columnId":null,"sheetName":"MLC-Inventory扣减(2019)"}},{"columnId":2963365875214212,"value":"https://mesterleds.com/wp-content/uploads/2017/12/WP01-45W70W.png","displayValue":"https://mesterleds.com/wp-content/uploads/2017/12/WP01-45W70W.png"},{"columnId":7466965502584708},{"columnId":1837465968371588},{"columnId":6341065595742084},{"columnId":4089265782056836},{"columnId":8592865409427332},{"columnId":430091084818308,"value":175.0,"displayValue":"175"},{"columnId":4933690712188804},{"columnId":2681890898503556},{"columnId":7185490525874052},{"columnId":1555990991660932},{"columnId":6059590619031428}]},{"id":7080298036914052,"rowNumber":3,"siblingId":2576698409543556,"expanded":true,"createdAt":"2019-01-31T00:06:35Z","modifiedAt":"2019-02-18T16:56:50Z",
Each row of table I need starts with:"cells';[{" while I only need "displayValue": for columns!
I tried several solutions and suggestions from various threads from StackOverflow but... no luck!
Below is desired output:
Final excel format (unneccessary columns hidden)
If only after displayValue you can use the following with jsonconverter.bas. You add the .bas to your project and then VBE > Tools > References> Add a reference to Microsoft Scripting Runtime.
Option Explicit
Public Sub IMPORTMESTER()
Dim xTOK As String
Dim URL As String
Dim httpREQ As Object
Dim json As Object
Dim xLINE As Variant
xTOK = "token"
URL = "https://api.smartsheet.com/2.0/sheets/7352150637471620"
Set httpREQ = CreateObject("MSXML2.XMLHTTP.6.0")
With httpREQ
.Open "GET", URL, False
.setRequestHeader "Authorization", "Bearer " & xTOK
.setRequestHeader "Content-Type", "application/json"
.send
End With
xLINE = httpREQ.responseText
Set json = JsonConverter.ParseJson(xLINE)("rows")
Dim item As Object, nextitem As Object, i As Long
For Each item In json
For Each nextitem In item("cells")
i = i + 1
ActiveSheet.Cells(i, 1) = nextitem("displayValue")
Next
Next
End Sub
The item you want is nested within the json where {} is a dictionary, and [] is a collection.
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
Consider this JSON object:
{
"fileName": "Batch_01032023_SakerItemData.xlsx",
"fileLocation": "C:\\Temp",
"message": "There are 3 errors. Please correct and try again.",
"error": [
"{Item} failed validation:Item is required.:8",
"{Type} failed validation:Type is required.:8",
"{Class} failed validation:Class is required.:8"
]
}
I am using the JsonConverter from this repo https://github.com/VBA-tools/VBA-JSON
Consider this VBA code:
Dim jsonObject As Object, item As Object
Dim objHTTP As Object
Dim url As String
Dim result As String
Dim async As Boolean
Dim body As String
body = "{""fileLocation"":""{fileLocation}""}"
body = Replace(body, "{fileLocation}", Replace(fileLocation, "\", "\\"))
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
With objHTTP
.Open "POST", url, async
.SetRequestHeader "Content-Type", "application/json"
.SetRequestHeader "Accept", "application/json"
.SetRequestHeader "Authorization", "Basic " + _
Base64Encode(authUser + ":" + authPassword)
.Send body
.waitForResponse
result = .responseText
End With
Set jsonObject = ParseJson(result)
*** What is the syntax here to loop through error object? ****
For Each item In jsonObject("error")(1)
Next
this line Set jsonObject = ParseJson(result) does not throw an error and seems to work, yet when I get to the 'for each' loop, I get Error # 424 'Object Required'.
My question is this: How can I loop through the 'error' array in the 'jsonObject' so that I can display the validation errors to the user? The error array is dynamic.
The key error returns a Collection, so first assign it to a variable declared as Collection...
Dim col As VBA.Collection
Set col = jsonObject("error")
Then loop through each item in the collection...
Dim itm As Variant
For Each itm In col
Debug.Print itm
Next itm
I am trying this cod but ist showing type mismatch.
Option Explicit
Sub nse5()
Dim req As New MSXML2.XMLHTTP60
Dim url As String
Dim json As Object
url = "https://www.nseindia.com/api/option-chain-indices?symbol=NIFTY"
With req
.Open "GET", url, False
.send
Set json = JsonConverter.ParseJson(.responseText)
End With
Debug.Print json("filtered")("data")(1)(2)("openInterest")
End Sub
I have tryed many ways but i am suffring from it that hou to bring specific data to print
I am using an API. I have credentials. It returns XML instead of JSON.
Sub usbRequest()
Dim objRequest As MSXML2.XMLHTTP60
Dim strURL As String
Set objRequest = New MSXML2.XMLHTTP60
strURL = "https://someAPIURL.com/"
objRequest.Open "GET", strURL, True, "MyUserName", "MyPassword"
objRequest.setRequestHeader "Content-Type", "application/json"
objRequest.send
While objRequest.readyState <> 4
DoEvents
Wend
Debug.Print objRequest.responseText
End Sub
The API Documentation indicates that an Accept header specifying JSON should return JSON. I do have a reference set to Microsoft XML V 6.0.
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