Here is my Code i have tried many searching but didnt find right solution please help there.
Sub JnewCOP22()
Dim req As New MSXML2.XMLHTTP60
Dim URL As String, ws As Worksheet
Dim json As Object, r, r1 As String, i, j As Integer
URL = "https://www.nseindia.com/api/quote-equity?symbol=DRREDDY§ion=trade_info"
With req
.Open "GET", URL, False
.send
Set json = JsonConverter.ParseJson(.responseText)
r = json("securityWiseDP")("quantityTraded")
End With
MsgBox r
End Sub
The API Data
{"noBlockDeals":true,"bulkBlockDeals":[{"name":"Session I"},{"name":"Session II"}],"marketDeptOrderBook":{"totalBuyQuantity":0,"totalSellQuantity":264,"bid":[{"price":0,"quantity":0},{"price":0,"quantity":0},{"price":0,"quantity":0},{"price":0,"quantity":0},{"price":0,"quantity":0}],"ask":[{"price":4659.2,"quantity":264},{"price":0,"quantity":0},{"price":0,"quantity":0},{"price":0,"quantity":0},{"price":0,"quantity":0}],"tradeInfo":{"totalTradedVolume":1945164,"totalTradedValue":92498.58,"totalMarketCap":7713541.51,"ffmc":5659504.6195251,"impactCost":0.02},"valueAtRisk":{"securityVar":10.89,"indexVar":0,"varMargin":10.89,"extremeLossMargin":3.5,"adhocMargin":0,"applicableMargin":14.39}},"securityWiseDP":{"quantityTraded":1945164,"deliveryQuantity":417789,"deliveryToTradedQuantity":21.48,"seriesRemarks":null,"secWiseDelPosDate":"29-OCT-2021 EOD"}}
The error massage says error parsing json <!Doctype h ^ expecting ' {' or '[ '
It seems that your request does not return JSON as you expected, but rather an ordinary HTML document.
In order to request a JSON document, you (probably) should set the HTTP request header Accept to application/json.
Related
I'm trying to retrieve a JSON response object through the below query API. When I try to read the responseText in VBA I receive an empty result. However, the exact same request returns correct data from PostMan. Also, the correct data returns from sending the different request bodies. Whenever I try to execute Set Json = JsonConverter.ParseJson(strResponse) and I'm getting the error message Error Parsing JSON: ^ Expecting '{' or '['. Can you please help?
This is VBA code
Dim strUrl As String
Dim reqBody As String
'For search GOSS service API-Step1
strUrl = "https://gossrepo.ins.dell.com/gossv3/api/reporting/service/getrefid"
'create a method for calling HTTP services
Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "POST", strUrl, blnAsync, False
reqBody = "{""methodType"":extract,""sourceApplication"":DSA,""searchParameter"":[{""conditionType"":term,""key"":global_bu_id,""value"":11},{""conditionType"":wildcard,""key"":customer_num,""value"":[530007546697]},{""conditionType"":range,""key"":order_date,""value"":[{""from"":2021-08-31,""to"":2021-09-09}]},{""conditionType"":sort,""key"":order_date_time,""value"":desc}],""pageSize"":40,""pageNum"":0}"
.SetRequestHeader "Content-type", "application/json"
.Send reqBody
While hReq.ReadyState <> 4
DoEvents
Wend
'wrap the response in a JSON root tag "data" to count returned objects
strResponse = hReq.ResponseText
Debug.Print strResponse
End With
Set Json = JsonConverter.ParseJson(strResponse)
Updated the fixed with the different post body:
Dim strUrl As String
Dim reqBody As String
'For search GOSS service API-Step1
strUrl = "https://gossrepo.us.dell.com/gossv3/api/reporting/service/getdata"
'create a method for calling HTTP services
Set hReq = CreateObject("MSXML2.XMLHTTP")
With hReq
.Open "POST", strUrl, blnAsync, False
reqBody = "{""methodType"":""details"",""sourceApplication"":""DSA"",""pageNum"":0,""pageSize"":300,""searchParameter"":[{""conditionType"":""term"",""key"":""global_bu_id"",""value"":""11""},{""conditionType"":""wildcard"",""key"":""customer_num"",""value"":[""" & ws & """]},{""conditionType"":""range"",""key"":""order_date"",""value"":[{""from"":""" & ws11 & """,""to"":""" & ws12 & """}]},{""conditionType"":""sort"",""key"":""order_date_time"",""value"":""desc""}]}"
.SetRequestHeader "Content-type", "application/json"
.Send reqBody
While hReq.ReadyState <> 4
DoEvents
Wend
'wrap the response in a JSON root tag "data" to count returned objects
strResponse = hReq.ResponseText
End With
Set Json = JsonConverter.ParseJson(strResponse)
Probably your request is wrong and you don't get the expected response because of it... Look at the status that's returned (hReq.status and hReq.statusText), I bet it's 400 Bad Request or 500 Internal Error and not 200 Ok. (You could also use an inspecting proxy like Fiddler to look at what exactly you send and receive here.)
I can already see your request body is invalid JSON as it has unquoted strings in it... It's not the exact same as you showed in Postman! That's like the issue (or one of the issues). You have e.g. "methodType": extract, but it has to be "methodType": "extract" (in VBA ""methodType"": ""extract"") - you did it correctly in Postman but wrong in your code.
As mentioned by CherryDT - Your original reqBody had alot of missing quotes and in your updated reqBody, you are missing quotes for order_date and also you quoted pageSize and pageNum value which is supposed to be a number and thus quotes is not required:
Below should give you the same JSON string as what you had in Postman:
reqBody = "{""methodType"":""extract"",""sourceApplication"":""DSA"",""searchParameter"":[{""conditionType"":""term"",""key"":""global_bu_id"",""value"":""11""},{""conditionType"":""wildcard"",""key"":""customer_num"",""value"":[""530007546697""]},{""conditionType"":""range"",""key"":""order_date"",""value"":[{""from"":""2021-08-31"",""to"":""2021-09-09""}]},{""conditionType"":""sort"",""key"":""order_date_time"",""value"":""desc""}],""pageSize"":40,""pageNum"":0}"
One way which has been working well for me so far is:
Copy the JSON string from Postman to Notepad
Open Replace dialog (Ctrl-H)
Enter " in Find What
Enter "" in Replace with
Click Replace All
Now you can copied the new string back to your VBA editor and it should produce the same output as Postman's.
I am trying to retrieve a particular field, resolve, from JSON. I am not sure as to how I can go about getting that one field. I added the Msgbox [Exists & Fail] to see if the code is able to read the word resolve within the cell, however i am returned with fail.
Is there any way i can get only the field resolve? Kindly assist.
Thank you!
TargetURL = "https://api.passivetotal.org/v2/dns/passive?query=passivetotal.org"
actionType = "Content-Type"
actionWord = "application/json"
With CreateObject("Microsoft.XMLHTTP")
.Open "GET", TargetURL, False
.setRequestHeader actionType, actionWord
.setRequestHeader "Authorization", "Basic <Encoded 64>"
.send
If .Status = 200 Then
Sheets(6).Cells(Count, 10).Value = "Connected"
Debug.Print .responseText
MsgBox .responseText
Set JSON = ParseJson(.responseText)
Sheets(6).Cells(Count, 8).Value = .responseText
If Sheets(6).Cells(Count, 8).Value = ("resolve") Then
MsgBox ("Exists")
Else
MsgBox ("Fail")
End If
Else
MsgBox .Status & ": " & .StatusText
End If
End With
Parsing the JSON response:
The following reads in the results json from a file and parses out each resolve. It uses JSONConverter.bas. Note I have extracted the"results" JSON collection in my python script which would be the same as you doing json("results") on the converted JSON string via Set json = JsonConverter.ParseJson(.responseText)("results").
After adding JSONConverter.bas to your project you need to go tools > references > Add reference to Microsoft Scripting Runtime
Option Explicit
Public Sub GetJSONExtract()
Dim fso As Object, jsonFile As Object, jsonText As String, json As Object, item As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set jsonFile = fso.OpenTextFile("C:\Users\User\Desktop\Sample.json")
jsonText = jsonFile.ReadAll
Set json = JsonConverter.ParseJson(jsonText) '<== Using results collection
'Set json = JsonConverter.ParseJson(.responseText)("results") '<== In your vba XMLHTTP version
For Each item In json
Debug.Print item("resolve")
Next
End Sub
As you were after how to parse the JSON that it was I have shown.
Additional notes:
I actually used the python script shown below; adapted from the API documentation. I then added in a bit of code to write the response out to a JSON file for later import. Run using Anaconda/Spyder.
import requests
import json
username = 'xxx'
key = 'yyy'
auth = (username, key)
base_url = 'https://api.passivetotal.org'
def passivetotal_get(path, query):
url = base_url + path
data = {'query': query}
response = requests.get(url, auth=auth, json=data)
return response.json()
pdns_results = passivetotal_get('/v2/dns/passive', 'passivetotal.org')
for resolve in pdns_results['results']:
print('Found resolution: {}'.format(resolve['resolve']))
with open(r"C:\Users\User\Desktop\Output.json", "w") as text_file:
text_file.write(json.dumps(pdns_results['results']))
That prints out all the resolves.
The original returned JSON structure looks like:
The object returned is a collection of dictionaries. You access the required value by the dictionary key "resolve"
I am having trouble sending JSON data to a firebase database using the rest API, the data is sent, but it does not parse. For instance if I use this curl command in command prompt in windows:
curl -X PUT -d "{\"lastName\":\"Jones\",\"firstName\":\"Bubba\"}" https://<database-name>.firebaseio.com/rest/test/.json
That results in the correct parsing of the data:
Yet, when using the following VBA code:
Sub PUSHhttpRequestTest() 'Doesn't Work!!
Dim sc As Object
Set sc = CreateObject("ScriptControl")
sc.Language = "JScript"
Dim strURL As String: strURL = "https://<database-name>.firebaseio.com/rest/.json"
Dim strRequest
strRequest = """{\""lastName\"":\""Jones\"",\""firstName\"":\""Bubba\""}"""
Dim XMLhttp: Set XMLhttp = CreateObject("msxml2.xmlhttp")
Dim response As String
Debug.Print strRequest
XMLhttp.Open "PUT", strURL, False
XMLhttp.setrequestheader "Content-Type", "application/json;charset=UTF-8"
XMLhttp.sEnd strRequest
response = XMLhttp.responseText
Debug.Print response
End Sub
This sends exactly the same stringified JSON, and it gets added to the Firebase database, however, the JSON string doesn't get parsed:
I have tried different Content Types, and variations on the JSON string, but nothing seems to work. Can anyone explain how I can get the VBA script to send data that Firebase will parse?
Thanks
I found a possible solution to sending JSON data from excel to firebase, but it doesn't answer my question about why the above VBA code sending a Stringified JSON doesn't get parsed in Firebase. I would still like a solution to that, because I already have a function the creates the stringified JSON from my data.
Using the VBA-web Library from this Stack Overflow post seems to do the trick. The example uses dictionaries for your data, however please my comment and the subsequent reply regarding the format of the JSON string to send. No escape code is required!
There is no PUT, and Other request types for json, but you can easily add these in yourself.
The equivalent code to the above, but using VBA-web library (with custom PutJson function) is:
Sub test()
Dim strURL As String: strURL = "https://<database-name>/rest/test/whatwhat/.json"
Dim strRequest As String: strRequest = "{""LastName"":""Jones"",""firstName"":""Bubba""}"
Dim Client As New WebClient
Dim Response As WebResponse
Set Response = Client.PutJson(strURL, strRequest)
ActiveSheet.Range("A1").Value = Response.Content
End Sub
And we end up with this....
Happy Days!
However, I'd still like to know why the seemingly identical curl and VBA HTTP requests result in different parsing of the data in FireBase?
I was trying to get some information from a JSON API and everything was going OK. So I started to get mismatch errors when I try to parse values that are inside the “root” of the JSON.
The code I use is below:
Public Sub Times()
Dim http As Object, JSON As Object, i As Integer
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", "https://api.cartolafc.globo.com/time/id/1084847/7", False
http.Send
Set JSON = ParseJson(http.responseText)
i = 2
Application.ScreenUpdating = False
Sheets("Youtube").Select
For Each Item In JSON
Sheets("Mais Escalados").Cells(i, 2).value = Item("pontos")
i = i + 1
Next
Application.ScreenUpdating = True
MsgBox ("Atualização Completa")
End Sub
I can parse the data inside atletas sub-items or any other header changing the code like this:
Sheets("Mais Escalados").Cells(i, 2).value = Item("atletas")("nome")
But when I try to parse information like pontos on the root I get the mismatch error.
This will give you the root value for the key "pontos":
JSON("pontos")
You can't loop over the root keys like you show in your posted code: you would need to check the type of each key's value before you try to write it to the sheet:
Public Sub Times()
Dim http As Object, JSON As Object, i As Integer, k
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", "https://api.cartolafc.globo.com/time/id/1084847/7", False
http.Send
Set JSON = ParseJson(http.responseText)
For Each k In JSON
Debug.Print k, TypeName(JSON(k))
Next
End Sub
Output:
atletas Collection
clubes Dictionary
posicoes Dictionary
status Dictionary
capitao_id Double
time Dictionary
patrimonio Double
esquema_id Double
pontos Double
valor_time Double
rodada_atual Double
this is the code I use to call parseJson in vba and in one case where I have a JSON object, I am receiving the error 10001 which relates to the latest Json-vba library 2.2.3 when the "{" or the "[" are expected.
Sub jsontest()
Dim http As Object
Set http = CreateObject("MSXML2.XMLHTTP")
'http.Open "GET", "https://bin.codingislove.com/document/ayequrimiy", False
http.Open "GET", "https://bin.codingislove.com/ayequrimiy.json", False
http.send
MsgBox (ParseJson(http.responseText)("Count"))
End Sub
The second .json file shows the 10001 error but the first one, the same file in text form, is perfectly executing. I tried as well including brackets when I call the json string without success.
What should I correct in my parser call?
Using developer tools with call to your second url https://bin.codingislove.com/ukiyerovow.json, it can be seen that the json is returned from url https://bin.codingislove.com/documents/ukiyerovow like this:
{
"data":
"{
\"Count\":1,
\"results\":
[
{
\"showEmailIcon\":true,
\"showIcon\":true,
\"middleName\":\"\",
\"dateActivated\":1513000,
\"regAffiliateRebate\":\"No Rebate(0)\",
\"Id\":1,
\"dateLastLogin\":1513248842000,
\"countryName\":\"France\",
\"address\":null,
\"name\":\"cien\",
\"id\":1786511,
\"state\":null
}
],
\"resultClass\":\"com.zoho.dao.dto\"
}",
"key":"ayequrimiy"
}
Using Json-vba library this strign can be parsed like this. HTH
Sub jsontest()
Dim http As Object
Set http = CreateObject("MSXML2.XMLHTTP")
' use this url instaed:
Const url As String = "https://bin.codingislove.com/documents/ayequrimiy"
http.Open "GET", url, False
http.send
Dim parsedJson As Dictionary
Set parsedJson = JsonConverter.ParseJson(http.responseText)
Dim data As String
data = parsedJson("data")
Dim parsedData As Dictionary
Set parsedData = ParseJson(data)
MsgBox parsedData("Count")
End Sub
What should I correct in my parser call?
You have to correct the url. The second url should be https://bin.codingislove.com/documents/ayequrimiy. There is the json data.
Compare:
https://bin.codingislove.com/ayequrimiy.json
https://bin.codingislove.com/documents/ayequrimiy
To get e.g. Name you have to use the results which contains array so first point to the element of the array using index e.g. (1) and then take the element ("Name"):
Debug.Print parsedData("reports")(1)("Name")
Since this isn't a JSON response, you will have to make it one before you can a parse it as such. The easiest approach is to load the DOM of the page, and then extract the text.
There are lots of snippets on SO (here's one) that'll do just that.
Once you have the DOM, do something like this:
json = doc.getElementById("box").innerText