I have the following json array which you can easily access at the below url:
https://crowdfluttr.firebaseio.com/test/array.json
It has the following output:
{"-0p":{"date":"2015-01-01","string":"apple","value":1},"-1p":{"date":"2015-02-04","string":"banana","value":50},"-2p":{"date":"2015-02-03","string":"carrot","value":99},"-3p":{"date":"2015-02-02","string":"banana","value":20},"-4p":{"date":"2015-03-01","string":"banana","value":11},"-5p":{"date":"2015-04-01","string":"kiwi","value":23},"-6p":{"date":"2015-05-01","strawberry":"banana","value":10}}
I'd like to pull this json data from this url and then parse it to push into microsoft access.
I found resources explaining how to parse JSON (Parsing JSON, Parsing JSON in Excel VBA) but not pull it from a URL and then parseit
I would use XMLHTTP to download the JSON.
For parsing JSON with VBA see https://github.com/VBA-tools/VBA-JSON.
Download the ZIP file. Extract the JsonConverter.bas. Open Excel and the VBA-editor with your VBA-project. Right click the VBA-project in Project Explorer and click Import File.... Browse to the JsonConverter.bas file and import it. Make sure, you have included a reference to "Microsoft Scripting Runtime" via Tools-References.
Example using your URL:
Sub test()
Dim httpObject As Object
Set httpObject = CreateObject("MSXML2.XMLHTTP")
sURL = "https://crowdfluttr.firebaseio.com/test/array.json"
sRequest = sURL
httpObject.Open "GET", sRequest, False
httpObject.send
sGetResult = httpObject.responseText
MsgBox sGetResult
Dim oJSON As Object
Set oJSON = JsonConverter.ParseJson(sGetResult)
For Each sItem In oJSON
dItemDate = oJSON(sItem)("date")
sItemString = oJSON(sItem)("string")
vItemValue = oJSON(sItem)("value")
MsgBox "Item: " & sItem & " Date: " & dItemDate & " String: " & sItemString & " Value: " & vItemValue
Next
End Sub
This code will work for your sample JSON like:
{"-0p":{"date":"2015-01-01","string":"apple","value":1},"-1p":{"date":"2015-02-04","string":"banana","value":50}, ... }
You will have to analyze the JSON you get from httpObject.responseText to adapt the code for getting values from other JSON structures.
Just in case someone stumbled on this same question but needs to send parameters first before getting the responseText, you will need to tweak Axel's answer a bit.
httpObject.Open "POST", sURL, False '// instead of GET, use POST //
httpObject.SetRequestHeader "Content-Type", "Application/json" '// specify header //
httpObject.Send "{""param1"":""value1"",""param2"":""value2""}" '// pass parameter //
sGetResult = httpObject.responseText '// get response //
The next step is the same parsing of result using the functions provided above.
You can study the answer here and then look up VBA.CVRAPI which contains all necessary Json modules to retrieve data from a URL. Though created for another purpose, the Json modules are generic and can easily be reused.
The demo form included demonstrates this. You should be able to adopt it to your URL for a test.
Related
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?
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
I'm trying to get dollar exchange rate from http://www4.bcb.gov.br/pec/taxas/port/ptaxnpesq.asp?id=txcotacao into a Excel spreadsheet.
I tried to paste as refreshable web query, however, the page opens one step earlier with a form, which has default inputs (that work for me) and then the query copies stuff from this page.
I tried to write a code to submit the form. I tried the .submit, .Click, .FireEvent and many other things I found on internet.
I tried to refer to the button by its name, class, tag, ...
<input title="Pesquisar" class="botao" onclick="limparVazio()" type="submit" value="Pesquisar">
I tried to trigger the form directly or bypass it
<form name="consultarBoletimForm" action="/ptax_internet/consultaBoletim.do?method=consultarBoletim" method="post">
You can use the bcb.gov.br Open Data Portal.
Send a request for a JSON response with the conversion rates from their Exchange rates – daily bulletins.
With the received response, amongst other methods, you can then:
Use the JSON Converter and set the convert the response into a JSON object and work with that;
Parse the response as a string with a regex to get the values
Looking at the results for today's rate on the site:
Input:
Output:
Result:
You can see USD 1 = 3,7048 BRL
① Using JSON object:
Example string to make request:
"https://olinda.bcb.gov.br/olinda/service/PTAX/version/v1/odata/ExchangeRatePeriod(moeda=#moeda,dataInicial=#dataInicial,dataFinalCotacao=#dataFinalCotacao)?%40moeda=%27" & TARGET_CURRENCY & "%27&%40dataInicial=%27" & START_DATE & "%27&%40dataFinalCotacao=%27" & END_DATE & "%27&%24format=json"
I include the start date, end date and currency in the string as well as specify the response format as JSON. I have selected the date to match the website view shown in the images above.
The JSON response is as follows:
I read the response into a string variable and then use JsonConverter.ParseJson(strJSON) to convert to a JSON object, stored in json variable. A quick inspection of the structure:
The begining "{" tells me that json is a dictionary.
I can also see that json("value") is a collection of dictionaries and that the value I am interested in, 3,7048 - remember from the website images above, is stored as "cotacaoCompra".
I can thus use the following script to access that value. The JSON response actually gives rates at 5 different times on that date in question. These are all printed out. The Fechamento (Closing) bulletin rate of 3,7048 we can see matches.
Code:
Option Explicit
Public Sub GetInfo()
Dim strURL As String, strJSON As String, item As Variant, http As Object, json As Object
Const TARGET_CURRENCY As String = "USD"
Const START_DATE As String = "06-13-2018"
Const END_DATE As String = "06-13-2018"
strURL = "https://olinda.bcb.gov.br/olinda/service/PTAX/version/v1/odata/ExchangeRatePeriod(moeda=#moeda,dataInicial=#dataInicial,dataFinalCotacao=#dataFinalCotacao)?%40moeda=%27" & TARGET_CURRENCY & "%27&%40dataInicial=%27" & START_DATE & "%27&%40dataFinalCotacao=%27" & END_DATE & "%27&%24format=json"
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", strURL, False
http.send
strJSON = http.responseText
Set json = JsonConverter.ParseJson(strJSON)
For Each item In json("value")
Debug.Print "rate " & item("cotacaoCompra") & " at " & item("dataHoraCotacao")
Next item
End Sub
Script output:
Notes:
Requires JSONConverter bas added and VBE > Tools > References > Microsoft Scripting RunTime)
② Parsing the responseText with a regex to get the rates:
The regex I will use is
"cotacaoCompra":\d{1,}.\d{1,}
This looks for the literal string "cotacaoCompra":, followed by 1 or more numbers then a ".", then one of more numbers.
I then have to remove the string "cotacaoCompra": with a straight forward replace. Ideally, I would just extract the numbers with "(?<=""cotacaoCompra"":)\d{1,}.\d{1,}"; basically, that says after, but not including "cotacaoCompra":. But that doesn't appear to be supported.
With that in mind the script to get the rates with regex:
Code:
Public Sub GetInfo2()
Dim strURL As String, strJSON As String, item As Variant, http As Object, json As Object
Const TARGET_CURRENCY As String = "USD"
Const START_DATE As String = "06-13-2018"
Const END_DATE As String = "06-13-2018"
strURL = "https://olinda.bcb.gov.br/olinda/service/PTAX/version/v1/odata/ExchangeRatePeriod(moeda=#moeda,dataInicial=#dataInicial,dataFinalCotacao=#dataFinalCotacao)?%40moeda=%27" & TARGET_CURRENCY & "%27&%40dataInicial=%27" & START_DATE & "%27&%40dataFinalCotacao=%27" & END_DATE & "%27&%24format=json"
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", strURL, False
http.send
strJSON = http.responseText
Dim Matches As Object
With CreateObject("VBScript.RegExp")
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = """cotacaoCompra"":\d{1,}.\d{1,}" 'The pattern I really wanted, "(?<=""cotacaoCompra"":)\d{1,}.\d{1,}", doesn't appear to be supported
If Not .test(strJSON) Then Exit Sub
Set Matches = .Execute(strJSON)
Dim match As Object
For Each match In Matches
Debug.Print Replace(match, """cotacaoCompra"":", vbNullString)
Next
End With
End Sub
I am trying to build Excel page from iTunes query data.
An example for Angry Birds app my query would look like:
https://itunes.apple.com/lookup?id=343200656&country=AL checking Albania iTunes
https://itunes.apple.com/lookup?id=343200656&country=DZ checking Algeria iTunes
... 150 more stores
My question is the most efficient way to do this query and parse response.
I only know how to to xmlhttp query. Please enlighten me as the better way to do this.
I have read some documentation for VB-JSON, Json.net, CDataSet, fastJSON, but cannot figure out how to get started trying those tools. Anyone have more VBA code examples pulling JSON or way to explain usage of these frameworks to a newb?
Dim innerHTML As Object
Dim myText As String
JsonCheck = ""
Set innerHTML = CreateObject("Microsoft.XMLHTTP")
With innerHTML
.Open "GET", iTunesAPI_link, False
.send
myText = .responsetext
End With
Set innerHTML = Nothing
If InStr(myText, ":0") = 20 Then 'no results found
result = "Down"
ElseIf InStr(myText, "Your request produced an error.") = 46 Then 'link error
result = HTMLCheck(human iTunes link)
Else 'found the app
result = call function which parses myText for desired fields
Endif
Here's a basic approach using the scriptcontrol:
Sub Tester()
Dim json As String
Dim sc As Object
Dim o
Set sc = CreateObject("scriptcontrol")
sc.Language = "JScript"
json = HttpGet("https://itunes.apple.com/lookup?id=343200656&country=AL")
'some json property names may be keywords in VBA, so replace with
' something similar....
json = Replace(json, """description""", """description_r""")
Debug.Print json
sc.Eval "var obj=(" & json & ")" 'evaluate the json response
'add some accessor functions
sc.AddCode "function getResultCount(){return obj.resultCount;}"
sc.AddCode "function getResult(i){return obj.results[i];}"
Debug.Print sc.Run("getResultCount")
Set o = sc.Run("getResult", 0)
Debug.Print o.kind, o.features, o.description_r
End Sub
Function HttpGet(url As String) As String
Dim oHTML As Object
Set oHTML = CreateObject("Microsoft.XMLHTTP")
With oHTML
.Open "GET", url, False
.send
HttpGet = .responsetext
End With
End Function
There's a worked-out approach in Codo's answer to this question: Excel VBA: Parsed JSON Object Loop
I had a similar issue with querying Salesforce's REST API and found dealing with JSON through ScriptControl ended up being unmanageable. I used the following library for parsing and converting to JSON and it's worked perfectly for me: https://code.google.com/p/vba-json/.
Dim JSON As New JSONLib
Dim Parsed As Object
Set Parsed = JSON.parse(jsonValue)
Debug.Print Parsed("resultCount")
Debug.Print Parsed("results")(0)
Using that library, I then wrapped up some of the common functionality for making web requests that I think would help you out: https://github.com/timhall/Excel-REST
Using these libraries, your code would look something like the following:
Dim iTunesClient As New RestClient
iTunesClient.BaseUrl = "https://itunes.apple.com/"
Dim Request As New RestRequest
Request.Format = json
Request.Resource = "lookup"
Request.AddQuerystringParam "id", "343200656"
Request.AddQuerystringParam "country", "AL"
Dim Response As RestResponse
Set Response = iTunesClient.Execute(Request)
' => GET https://itunes.apple.com/lookup?id=343200656&country=AL
If Response.StatusCode = 200 Then
' Response.Data contains converted JSON Dictionary/Collection
Debug.Print "Result Count: " & Response.Data("resultCount")
Dim i As Integer
For i = LBound(Response.Data("results")) To UBound(Response.Data("results"))
Debug.Print "Result " & i & ": " & Response.Data("results")(i)
Next i
Else
Debug.Print "Error: " & Response.Content
End If