I'm looking for a solution to automatically update a cell in my Excel Table via a JSON Webservice. I've found a way to do this via XML, but unfortunately no way to do this via JSON.
The Webservice I want to use is: https://mtgox.com/api/1/BTCUSD/ticker
And I would like to use the value of return.avg.value in my table.
I even thought of using RegEx to get the value but I could't find a way to do so, also.
I really hope there is a solution to my problem without using a lot of different Addons and Plugins for Excel, so my table remains portable.
Thank you for your help,
Frederick
Sub TestJson()
Dim json As String
Dim sc As Object, o
json = WebResponse("https://mtgox.com/api/1/BTCUSD/ticker")
Set sc = CreateObject("ScriptControl")
sc.Language = "JScript"
o = sc.Eval("eval(" & json & ")['return'].avg.value")
Debug.Print o
End Sub
Public Function WebResponse(sURL As String) As String
Dim XmlHttpRequest As Object
Set XmlHttpRequest = CreateObject("Msxml2.ServerXMLHTTP.4.0")
XmlHttpRequest.Open "GET", sURL, False
XmlHttpRequest.send
WebResponse = XmlHttpRequest.responseText
End Function
Related
My objective is to run a search for some data and return the results into an excel table. I'm using the service newsapi.org and using VBA to do this.
I'm sending a XMLHttpRequest to newsapi.org and successfully receiving a (JSON) response, which I am able to save into a file on my desktop. I however cannot import that response into excel as I receive run-time error 13: type mismatch.
Bizarrely when I change my source to a different JSON file, it works. e.g. http://jsonplaceholder.typicode.com/users
So I'm assuming the issue is somewhere around the type of the JSON response I am receiving.
Public Sub xmlhttptutorial()
Dim xmlhttp As Object
Dim myurl As String
Dim JSON As Object
Dim myFile As String
Dim i As Integer
Dim ws As Worksheet
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
Set ws = Sheet2
myFile = "C:\Users\A0781525\Desktop\myFile.txt"
myurl = "https://newsapi.org/v2/everything?q=Ashley%20Madison%20Data%20Breach&"
xmlhttp.Open "GET", myurl, False
xmlhttp.Send
Set JSON = JsonConverter.ParseJson(xmlhttp.ResponseText)
Open myFile For Output As #1: Print #1, xmlhttp.ResponseText: Close #1
i = 2
For Each Item In JSON
Range("A2").Value = Item("articles")("0:")("source")("id:")
Range("A2").Value = Item("articles")("0:")("source")("name")
Range("A2").Value = Item("articles")("0:")("title")
i = i + 1
Next
End Sub
The break occurs at line:
Range("A2").Value = Item("articles")("0:")("source")("id:")
A sample of the JSON file output I receive:
{"status":"ok","totalResults":16,"articles":[{"source":{"id":"mashable","name":"Mashable"},"author":"Jack Morse","title":"Porn site leaks over a million users' private info","description":"The great thing about the internet is that no one has to know you have a serious thing for hentai pornography. Unless, that is, the porn site you have an account on leaks your personal information. Over a million Luscious.net account holders faced that unexpe…","url":"https://mashable.com/article/porn-site-leaks-users-data/","urlToImage":"https://mondrian.mashable.com/2019%252F08%252F20%252F24%252F62fc9aa277d54b2092a39393d2202a62.856fe.jpg%252F1200x630.jpg?signature=MBXieHs3n4uvowiVyV4K8cCO4j4=","publishedAt":"2019-08-20T22:36:24Z","content":"The great thing about the internet is that no one has to know you have a serious thing for hentai pornography. Unless, that is, the porn site you have an account on leaks your personal information. \r\nOver a million Luscious.net account holders faced that unex… [+2840 chars]"}
You are parsing the JSON incorrectly. Probably due to a misunderstanding of how it is constructed.
Try something like:
i = 2
'Cells.Clear
For Each item In JSON("articles")
Cells(i, 1).Value = item("source")("id")
Cells(i, 2).Value = item("source")("name")
Cells(i, 3).Value = item("title")
i = i + 1
Next
The problem is with the way you are trying to access the parsed json elements.
Not having the exact structure of the JSON the best I can do is assume what you need to do is this:
Debug.Print JSON("articles")(1)("source")("id")
To access the first article's id.
or this
For Each item In JSON("articles")
Debug.Print item("source")("id")
Next item
to loop through them
I'm trying to scrape elements from xmlhttp.
I'm not too bad with vba, but relatively new to data scraping.
I have previously been using ie.
I can import the html into a cell, but would like to import specifically, the name, id, price and stock level.
The code I'm using to import the data is
Private Sub HTML_VBA_Excel()
Dim oXMLHTTP As Object
Dim sPageHTML As String
Dim sURL As String
'Change the URL before executing the code
sURL = "https://www.superdrug.com/Make-Up/Lips/Lip-Kits/Flower-Beauty-Mix-N%27-Matte-Lipstick-Duo-Tickled-Pink-687/p/769466"
'Extract data from website to Excel using VBA
Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP")
oXMLHTTP.Open "GET", sURL, False
oXMLHTTP.send
sPageHTML = oXMLHTTP.responseText
'Get webpage data into Excel
sh02.Cells(1, 1) = sPageHTML
End Sub
Thanks in advance for any help received.
Ian
You cannot extract the information reliably from an xmlhttp request issued against the url you show as the content is javascript loaded and will not have run.
Not sure how sustainable the token is (doesn't seem to matter the value used) but you can join the productid, which is the end of your url, with the ajax token present in the page and issue and xmlhttp request using querystring parameters and parse a json response for the items of interest. I use jsonconverter.bas. After downloading and installing the .bas you need to go VBE > Tools > References and add a reference to Microsoft Scripting Runtime.
Some testing seems to indicate any number can be added after the hyphen in place of the token so you could randomly generate a number on the fly to use.
It's worth noting you can comma separate multiple products in the query string and thus do a bulk request. You would need then do a For Each Loop over the collection of dictionaries returned.
Option Explicit
Public Sub GetInfo()
Const URL As String = "https://www.superdrug.com/micrositeProduct/bulk/769466-1548702898380"
Dim json As Object, title As String, price As String, stocking As String, id As String
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
Set json = jsonconverter.ParseJson(.responsetext)(1)
End With
title = json("name")
price = json("price")("formattedValue") 'json("price")("value")
stocking = json("stockLevel")
id = json("code")
End Sub
If you use a browser then the json string is present within one the script tags as the .innerHTML and you can easily extract from there.
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 have been trying to parse a bit of JSON data from an API as part of a larger project and due to my limited experience with VBA/Json I am having difficulties figuring out what the problem is with my VBA code.
I have used the following VBA Json Parsers and all basically stop working at the same point and give me an "incomplete parse".
vba-json https://code.google.com/archive/p/vba-json
vbjson www.ediy.co.nz/vbjson-json-parser-library-in-vb6-xidc55680
The Json I am trying to parse is the following:
{"links":[],"content":{"carrier":{"allowedToOperate":"Y","bipdInsuranceOnFile":"1000","bipdInsuranceRequired":"Y","bipdRequiredAmount":"750","bondInsuranceOnFile":"0","bondInsuranceRequired":"N","brokerAuthorityStatus":"N","cargoInsuranceOnFile":"0","cargoInsuranceRequired":"N","carrierOperation":{"carrierOperationCode":"A","carrierOperationDesc":"Interstate"},"commonAuthorityStatus":"A","contractAuthorityStatus":"A","crashTotal":19,"dbaName":null,"dotNumber":124871,"driverInsp":974,"driverOosInsp":33,"driverOosRate":3.38809034907597535934291581108829568789,"driverOosRateNationalAverage":"5.51","ein":460396676,"fatalCrash":0,"hazmatInsp":0,"hazmatOosInsp":0,"hazmatOosRate":0,"hazmatOosRateNationalAverage":"4.5","injCrash":6,"isPassengerCarrier":"N","issScore":null,"legalName":"A&A EXPRESS LLC","oosDate":null,"oosRateNationalAverageYear":"2009-2010","phone":"6055822402","phyCity":"BRANDON","phyCountry":"US","phyState":"SD","phyStreet":"1015 9TH AVENUE NORTH","phyZipcode":"57005","reviewDate":"2016-09-23","reviewType":"N","safetyRating":"S","safetyRatingDate":"2008-08-29","safetyReviewDate":"2016-09-23","safetyReviewType":"N","snapshotDate":"1485493200000","statusCode":"A","totalDrivers":237,"totalPowerUnits":253,"towawayCrash":13,"vehicleInsp":477,"vehicleOosInsp":58,"vehicleOosRate":12.15932914046121593291404612159329140461,"vehicleOosRateNationalAverage":"20.72"},"links"
my VBA code looks like the following:
Public Sub PARSEJSON()
Dim reader As New XMLHTTP60
Dim api As Object
Dim WS As Worksheet
Dim item As Variant
reader.Open "GET", "https://mobile.fmcsa.dot.gov/qc/services/carriers/124871?webKey=APIKEY", False
reader.send
Set WS = ActiveSheet
Set api = JSON.parse(reader.responseText)
For Each item In api
WS.Range("a3").Value = item("")
Next
End Sub
I cannot get into the JSON to reference the values that I need because the parser yields a result like:
photo of watcher in VBA
it seems like the Json parser is only breaking down part of the Json string from the API, it is from a government website so I am assuming it should be in a common Json format. I hope I included enough detail in this post to encompass the scope of my issue
I solved this issue, I looked further into how to reference a dictionary and realized I was using the wrong syntax to reference and adding in extra steps that were not needed.
new VBA code yields the results I want:
Public Sub PARSEJSON()
Dim reader As New XMLHTTP60
Dim dict As Object
Dim api As New Scripting.Dictionary
Dim json As New Class1
Dim WS As Worksheet
Dim key As Variant
Dim item As Variant
reader.Open "GET", "https://mobile.fmcsa.dot.gov/qc/services/carriers/124871?webKey=APIKEY", False
reader.send
Set WS = ActiveSheet
Set api = json.parse(reader.responseText)
MsgBox api("content")("carrier").Count
MsgBox api.item("content")("carrier")("driverOosInsp")
WS.Range("a1").value = api.item("content")("carrier")("driverOosInsp")
End Sub
The "reference URL list" part of the code is where I can drop an individual URL in and the code works fine. But I'd like to make the code more flexible where I can loop through my list of URLs (ideally only changing that portion of my code, or perhaps another small tweak). Here is the code:
Set MyRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
MyRequest.Open "GET", "reference URL list"
MyRequest.Send
Dim Json As Object
Set Json = JsonConverter.ParseJson(MyRequest.ResponseText)
I realize there are multiple ways to approach this -- though I can't find specific information that will slightly augment my approach. I really appreciate the help.
Kyle
This code should do what you want. The key idea is to use an Array to hold the list of website you want to send an HTTP request.
You don't have to use an array typed into VBA as I show below, you could also use a Range in Excel.
Here's the code:
Public Sub HTTP_Req()
Dim MyRequest As Object: Set MyRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
'Add all Urls you want to send a HTTP request to, in an Array
Dim MyUrls: MyUrls = Array("www.google.com", "www.yahoo.com", "www.bing.com")
Dim i As Long
Dim Json As Object
For i = LBound(MyUrls) To UBound(MyUrls)
With MyRequest
.Open "GET", MyUrls(i)
.Send
Set Json = JsonConverter.ParseJson(.ResponseText)
'Do something with the JSON object here
End With
Next
End Sub