I am not the greatest with vba coding.. some help will be much appreciated.
I have some code that I get via api and the response is returned in JSON. I need this converted so that it can then be inserted into cells. each request is a single response for one address. Please could some help with this.
Code I have done is below that works and gives me the correct response;
Sub api_request()
'Declare variables
Dim xml_obj As MSXML2.XMLHTTP60
'Create a reference to the Microsoft XML library
Set xml_obj = New MSXML2.XMLHTTP60
'Define URL Components
base_url = "https://api.getaddress.io/find/"
param_postcode = InputBox("Postcode Here")
param_postcode_val = "/"
param_number = InputBox("Number or Name")
param_number_val = "/"
param_api = "?api-key="
param_api_Value = "dAAsSIXtn9iKsObVq3L1kA11823=true"
'Combine all the different components into a single URL
api_url = base_url + _
param_postcode + param_postcode_val + _
param_number + param_number_val + _
param_api + param_api_Value
'Open a new request, specify the method and the URL
xml_obj.Open bstrMethod:="GET", bstrURL:=api_url
'Send the request
xml_obj.send
'Print the status response
Debug.Print xml_obj.responseText
End
End Sub
This is the output response text;
{"postcode":"MK13 0EZ","latitude":52.066448,"longitude":-0.783306,"addresses":[{"formatted_address":["10 Meads Close","","","New Bradwell, Milton Keynes","Buckinghamshire"],"thoroughfare":"Meads Close","building_name":"","sub_building_name":"","sub_building_number":"","building_number":"10","line_1":"33 Meads Close","line_2":"","line_3":"","line_4":"","locality":"New Bradwell","town_or_city":"Milton Keynes","county":"Buckinghamshire","district":"Milton Keynes","country":"England"}]}
I need this above output into a worksheet in excel and then any other requests that are done place under the above response and so on.. I really do hope that someone can help me.
Thanks
I won't answer your question directly, but I'll give you a sub that I've used in the past to give you a framework.
Basic Request
Dim XMLPage As New MSXML2.XMLHTTP60
Dim HTMLDoc As New MSHTML.HTMLDocument
Dim Code As String
Dim JSON As Object
Dim Key As Variant
Code = "500002"
XMLPage.Open "GET", "https://api.bseindia.com/BseIndiaAPI/api/StockTrading/w?flag="etype=EQ&scripcode=" & Code, False
XMLPage.send
Set JSON = JsonConverter.ParseJson(XMLPage.responseText)
For Each Key In JSON
Debug.Print Key & ": " & JSON(Key)
Next Key
The link to the JSON converter has been provided by another user in the comments.
Related
I want to import some data from a website https://www.amfiindia.com/nav-history-download. On this page, there is a link "Download Complete NAV Report in Text Format" which will give me the required data. But this link is not static so I cannot use this directly in VBA to download my data. So how to download data from a hyperlink on a webpage using excel?
My approach is first getting the hyperlink in a variable then use that variable to get the data?
First, get the hyperlink using getElementsByTagName function as shown below.
Then use that as URL to get the data.
But I am getting type mismatch error while equating website which is a string with my hyperlink.
I don't know the type of href. Tried seeing in watch window showing Variant, tried that still error.
Kindly help me with this.
Sub webscraping()
Dim request As Object
Dim response As String
Dim html As New HTMLDocument
Dim website As String
Dim price As Variant
Dim cellAddress As String
Dim rowNumber As Long
Dim ie As InternetExplorer
Dim ht As HTMLDocument
Dim hr As MSHTML.IHTMLElement
'Dim Hra As MSHTML.IHTMLElement
Set ie = New InternetExplorer
ie.Visible = True
ie.Navigate ("https://www.amfiindia.com/nav-history-download")
Do Until ie.ReadyState >= 4
DoEvents
Loop
Set ht = ie.Document
'MsgBox ht.getElementById("navhistorydownload")
Set hr = ht.getElementsByTagName("a")(18).href
' Website to go to.
website = StrConv(hr, vbUnicode)
' Create the object that will make the webpage request.
Set request = CreateObject("MSXML2.XMLHTTP")
' Where to go and how to go there - probably don't need to change this.
request.Open "GET", website, False
' Get fresh data.
request.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
' Send the request for the webpage.
request.send
' Get the webpage response data into a variable.
response = StrConv(request.responseBody, vbUnicode)
' Put the webpage into an html object to make data references easier.
html.body.innerHTML = response
' Get the price from the specified element on the page.
'price = html.getElementstagName("a").Item(0).innerText
cellAddress = Range("A" & Rows.Count).End(xlUp).Address
rowNumber = Range(cellAddress).Row
ThisWorkbook.Sheets(1).Cells(rowNumber + 1, 1) = response
' MsgBox rowNumber
' MsgBox cellAddress
' Output the price into a message box.
'MsgBox price
End Sub
If you don't know the type then you can use
?typename(ht.getElementsByTagName("a")(18).href)
in the immediate window.
It should be a string and declared as such.
Rather than indexing into an anchor collection I would grab by css selector
ht.querySelector(".nav-hist-dwnld a").href
This specifies the parent node with class name nav-hist-dwnld and then asks for the first child a tag.
This, website = StrConv(hr, vbUnicode) is not required. Use the extracted href direct.
I have an issue with understanding Excel VBA: Parsed JSON Object Loop.
I need a solution on the below code:
Sub getPricesOnReport()
Dim url As String: url = "http://statistics.mla.com.au/ReportApi/RunReport?ReportGuid=70587516-e17a-4065-a8aa-e3fe4c512159&FromDate=13%2F03%2F2017&ToDate=18%2F03%2F2017"
Dim httpRequest As Object: Set httpRequest = CreateObject("MSXML2.XMLHttp")
Dim httpResponse As Object
Dim scriptControl As Object: Set scriptControl = createObject("MSScriptControl.ScriptControl")
Dim XDOM As ListObject
scriptControl.Language = "JScript"
httpRequest.Open "GET", url, False
httpRequest.send
Set httpResponse = scriptControl.eval("(" + httpRequest.responseText + ")")
With Sheets("MLA")
If httpResponse.ResponseStatus <> "OK" Then
MsgBox "Error in Response"
Else
Cells(3, 2).Value = httpResponse.ResponseDate
Cells(3, 3).Value = httpResponse.ResponseHeader
Cells(3, 4).Value = httpResponse.ResponseStatus
Cells(3, 5).Value = httpResponse.ResponseDisclaimer
'Cells(4, 2).Value = httpResponse.returnValue '
End If
End With
End Sub
I am getting an error for the code
Cells(4, 2).Value = httpResponse.returnValue
though the object is available.
PFB image:
How do i modify the code to access the data?
In this case, Capitalization matters!
ReturnValue needs to be capitalized properly.
It may be defaulting to a "small r" when you type ReturnValue if there are other references to returnValue. (VBA is trying to be helpful by correcting the word to how you typed it before!)
In the VBA Editor:
hit Ctrl+H.
Enter ReturnValue for both Find What and Replace With.
Make sure Current Project is selected, and that Match Case is unchecked.
Click Replace All
Every occurrence of the word will be changed to the correct capitalization.
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.
I have a MS Access project that requires me retrieve and parse a Json object from a URL. I have done parse part, but I cannot figure out the correct way to retrieve the Json from the URL. If I copy and paste the URL on IE, it will automatically download the Json object as .json file for me. I have searched solution by Google, and none of them works for me. I think the problem is that the URL looks like "https://******.com/rest/external/session/123", which is not similar to a standard XML HTTP request URL. So most solutions which use XMLHTTP request does not work for me.
I have tried to use following code to get it from URL. But all I get is homepage DOM tree instead of Json.
Dim wb As XMLHTTP
Set wb = New XMLHTTP
wb.Open "POST", "https://******.com/rest/external/session/123", False
wb.send
Do Until wb.Status = 200 And wb.ReadyState = 4
DoEvents
Loop
Debug.Print wb.responseText
Anyone has any idea about what I should do here?
Any help is appreciated!
Updated:
I have tried both POST and GET http request. And it gave me the same result
Following are the processes captured by fiddler.
This is captured processes if I copy the url directly on IE
This is captured processes if I use the code above
Just explaining the code logic below. You will need to work on it to build your own code.
Option Compare Database
Dim ApiUrl As String
Dim reader As New XMLHTTP60
Dim coll As Collection
Dim Json As New clsJSONParser
Public Sub ApiInitalisation()
ApiUrl = "http://private-anon-73376961e-count.apiary-mock.com/"
End Sub
Public Sub GetPerson()
On Error GoTo cmdLogIn_Click_Err
'For API
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim contact As Variant
Api.ApiInitalisation
ApiUrl = ApiUrl & "users/5428a72c86abcdee98b7e359"
reader.Open "GET", ApiUrl, False
'reader.setRequestHeader "Accept", "application/json"
reader.send
'Temporay variable to store the response
Dim egTran As String
' Add data to Table
If reader.Status = 200 Then
Set db = CurrentDb
Set rs = db.OpenRecordset("tblPerson", dbOpenDynaset, dbSeeChanges)
egTran = "[" & reader.responseText & "]"
Set coll = Json.parse(egTran)
For Each contact In coll
rs.AddNew
rs!FName = contact.Item("name")
rs!Mobile = contact.Item("phoneNumber")
rs!UserID = contact.Item("deviceId")
rs!SID = contact.Item("_id")
rs.Update
Next
Else
MsgBox "Unable to import data."
End If
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