I can now able to send the pure text in HTTP using this code..
Public Function WebRequest(url As String, jsonFile As String) As String
'In this string, I am putting the parsed JSON file
jsonFile = ReadTextFile(jsonFile)
Dim http As MSXML2.XMLHTTP60
Set http = CreateObject("MSXML2.ServerXMLHTTP")
http.Open "POST", url, False
http.send jsonFile
WebRequest = http.responseText
Set http = Nothing
End Function
This function is just to parse the JSON file, I have CommonDialog control for choosing the file.
Public Function ReadTextFile(sFilePath As String) As String
On Error Resume Next
Dim handle As Integer
If LenB(Dir$(sFilePath)) > 0 Then
handle = FreeFile
Open sFilePath For Binary As #handle
ReadTextFile = Space$(LOF(handle))
Get #handle, , ReadTextFile
Close #handle
End If
End Function
That simple code will successfully POST a text in HTTP, but what I want is to post the exact JSON file, not just the text inside of it.
Related
I am trying to extract one Json data from NSE web site.This invlovles cookies,before executing the MACRO codes atleast open once the URL https://www.nseindia.com/get-quotes/derivatives?symbol=TCS.
So that Cookies problem will not be faced.
After this when i copy this Url "https://www.nseindia.com/api/quote-derivative?symbol=TCS" and run it in the web browser,i am receiving all the Json text starts with "{"info":{"symbol":"TCS","companyName":"Tata Consultancy Services Limited","in" etc etc.
How ever when i tried to get the same via excel macro ,i am receiving only the partial Json text, here i am attaching my macro codes and partial Json text as a image
Private Function Getresponse(ByVal Url As String) As String
Const RunAsync As Boolean = True
Const Processcomplete As Integer = 4
Dim request As MSXML2.XMLHTTP60
Set request = New MSXML2.XMLHTTP60
Dim Response As String
With request
.Open "GET", Url, RunAsync
.setRequestHeader "Content-Type", "application/json"
.send
Do While request.readyState <> Processcomplete
DoEvents
Loop
Response = .responseText
End With
Getresponse = Response
End Function
Sub Test_GetResponse()
Debug.Print Getresponse("https://www.nseindia.com/api/quote-derivative?symbol=TCS")
End Sub
Any suggestion why full response is not received please?
I have an Visual Basic 6 application which should read a file into a byte array, put that into a json object and make a post request to a rest API. I have everything working except the byte array part. When I use the code below, the API just receives the string "bytes" and not the actual content of the request that should look something like this "JVBERi0xLjQKJeLjz9MKCj"
Private Function PostDocumentPrint() As String
'Create http client
Dim http As Object
Set http = CreateObject("WinHttp.WinHttprequest.5.1")
url = "XXX"
http.Open "Post", url, False
'Set request parameters
http.SetRequestHeader "charset", "UTF-8"
http.SetTimeouts 500, 500, 500, 500
' Read file into byte array
Dim fileNum As Integer
Dim bytes() As Byte
fileNum = FreeFile
Open "FileToSend.pdf" For Binary As fileNum
ReDim bytes(LOF(fileNum) - 1)
Get fileNum, , bytes
Close fileNum
' Send the request
Dim jsonStringPostBody As String
jsonStringPostBody = " {""fileData"": "" " + bytes + """} "
http.Send jsonStringPostBody
End Function
I believe I need to convert the byte array to a string somehow. For example I tried this:
Dim s As String
s = StrConv(bytes, vbUnicode)
MsgBox s
But it does not look correct.
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 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
I want to parse stock quotes from the Robin Hood API via Excel VBA.
Say I want Amazon, which is https://api.robinhood.com/quotes/?symbols=AMZN.
Which produces:
{
"results":[
{
"ask_price":"1592.3900",
"ask_size":100,
"bid_price":"1591.0000",
"bid_size":500,
"last_trade_price":"1592.3900",
"last_extended_hours_trade_price":"1592.0000",
"previous_close":"1600.1400",
"adjusted_previous_close":"1600.1400",
"previous_close_date":"2018-05-07",
"symbol":"AMZN",
"trading_halted":false,
"has_traded":true,
"last_trade_price_source":"consolidated",
"updated_at":"2018-05-08T23:58:44Z",
"instrument":"https://api.robinhood.com/instruments/c0bb3aec-bd1e-471e-a4f0-ca011cbec711/"
}
]
}
Using an example like this answer, I have installed VBA-JSON and turned on Microsoft Scripting Runtime.
My code:
Public Sub STOCKQUOTE()
Dim http As Object
Set http = CreateObject("MSXML2.XMLHTTP")
Const sURL As String = "https://api.robinhood.com/quotes/?symbols=AMZN"
http.Open "GET", sURL, False
http.send
Dim jsonResponse As Dictionary
Set jsonResponse = JsonConverter.ParseJson(http.responseText)
Dim results As String
Set results = jsonResponse("results")
MsgBox results
End Sub
But this doesn't work, instead I get Compiler Error: Object Required for the line Set results = jsonResponse("results").
If I add Debug.Print http.responseText I see the correct JSON, but any idea what I'm doing wrong?
VBA-JSON is installed correctly, because if I use their example, it works fine:
Dim Json As Object
Set Json = JsonConverter.ParseJson("{""a"":123,""b"":[1,2,3,4],""c"":{""d"":456}}")
But if I try changing Dictionary to Object, I get Run-time error '450': Wrong number of arguments or invalid property assignment.
Your json has an object called results. There could be, but isn't, multiple result objects. You have only one, so I think it's leading to confusion. Each result is going to get it's own entry in your jsonResponse dictionary. The ITEM in that dictionary will, itself, be a dictionary.
The best way to deal with iterating through the dictionary in a dictionary is to declare a new dictionary, I'm calling att for "Attributes" and then fill that dictionary with each iteration through the jsonResponse dictionary. It will only iterate once though as you only have one result:
Public Sub STOCKQUOTE()
Dim http As Object
Set http = CreateObject("MSXML2.XMLHTTP")
Const sURL As String = "https://api.robinhood.com/quotes/?symbols=AMZN"
http.Open "GET", sURL, False
http.send
Dim jsonResponse As Dictionary
Set jsonResponse = JsonConverter.ParseJson(http.responseText)
Dim att As Dictionary
For Each att In jsonResponse("results")
Debug.Print att("last_trade_price")
Next att
End Sub
Alternatively, because you have only a single result, you could just refer to that result by it's index in the jsonResponse dictionary and then it's attribute you are after. This makes the code smaller, but if you ever get more than one result from your REST query it will be lost forever. No biggie though since you don't expect that to happen:
Public Sub STOCKQUOTE()
Dim http As Object
Set http = CreateObject("MSXML2.XMLHTTP")
Const sURL As String = "https://api.robinhood.com/quotes/?symbols=AMZN"
http.Open "GET", sURL, False
http.send
Dim jsonResponse As Dictionary
Set jsonResponse = JsonConverter.ParseJson(http.responseText)
MsgBox (jsonResponse("results")(1)("last_trade_price"))
End Sub