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 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.
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.
I'm getting below type of responses from an API:
"{"success":false,"error":"Incorrect apikey"}"
"{"success":true,"error":"Correct apikey"}"
In VBA, how to know if response is true or false ?
My current code is below and am getting response in hReq.ResponseText and it is not always fixed (more keys can be added to json). Although the part below is fixed and I have to get only if it returning true or false.
"{"success":false
Code:
Dim hReq As Object
Dim strUrl As String
strUrl = "https://myWebAPI/myMethod?apikey=123456"
Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "GET", strUrl, False
.Send
End With
MsgBox hReq.ResponseText
I know this is basic question but sorry am new to VBA.
Purely based on what you have shown you can get True/False with
Split(Split(hReq.ResponseText, ":")(1), ",")(0)
I'm attempting to pull data from a JSON file on the web. I'm using a dummy JSON file for the time being to get things working. My code is below, but it times out every time and doesn't return anything. The same happens if I use different URLs also.
Sub Test()
Dim strResult As String
Dim objHTTP As Object
Dim URL As String
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "https://jsonplaceholder.typicode.com/posts/2"
objHTTP.Open "GET", URL, False
objHTTP.Send
strResult = objHTTP.ResponseText
MsgBox strResult
End Sub
In case it's relevant, I have the following libraries enabled in the file:
Visual Basic for Applications
Microsoft Excel 15.0 Object Library
OLE Automation
Microsoft Scripting Runtime
Microsoft WinHTTP Services, version 5.1
What am I missing?
EDIT: Fixed. I wasn't aware of the distinction between WinHttpRequest and XMLHTTPRequest. When using the latter, the code worked fine. Thanks all.
Is there a special reason why using WinHttpRequest instead of XMLHTTPRequest?
While using WinHttpRequest the operating system defaults for HTTP requests - proxy settings for example - are not used and must be set explicitly:
Sub Test()
Dim strResult As String
Dim objHTTP As Object
Dim URL As String
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
objHTTP.SetProxy 2, "proxyIP:proxyPort"
URL = "https://jsonplaceholder.typicode.com/posts/2"
objHTTP.Open "GET", URL, False
objHTTP.setCredentials "username", "password", 1
objHTTP.Send
strResult = objHTTP.ResponseText
MsgBox strResult
End Sub
The 2 in IWinHttpRequest::SetProxy method is HTTPREQUEST_PROXYSETTING_PROXY.
The 1 in IWinHttpRequest::SetCredentials method is HTTPREQUEST_SETCREDENTIALS_FOR_PROXY.
While using XMLHTTPRequest the operating system defaults for HTTP requests are used as set in Internet Options in control panel. So the following should run if you are able accessing the URL via browser:
Sub Test()
Dim strResult As String
Dim objHTTP As Object
Dim URL As String
Set objHTTP = CreateObject("MSXML2.XMLHTTP.6.0")
URL = "https://jsonplaceholder.typicode.com/posts/2"
objHTTP.Open "GET", URL, False
objHTTP.Send
strResult = objHTTP.ResponseText
MsgBox strResult
End Sub
Your code works OK here, but perhaps you should .WaitForResponse if things are timing out:
Sub Test()
Dim strResult As String
Dim objHTTP As Object
Dim URL As String
Set objHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
URL = "https://jsonplaceholder.typicode.com/posts/2"
objHTTP.Open "GET", URL, False
objHTTP.Send
objHTTP.waitforresponse
strResult = objHTTP.ResponseText
MsgBox strResult
End Sub