I need to get the EUR price from json source API page https://api.coingecko.com/api/v3/coins/axie-infinity which is in some kind of 'tree' results.
The Rank market_cap_rank I'm able to get but current_price I'm not able.
My Code:
Public Class JsonResponse
<JsonProperty("market_cap_rank")>
Public Property _rank As String
<JsonProperty("current_price")>
Public Property _cPrice As String
End Class
Public Sub getRankAXS()
Try
ServicePointManager.SecurityProtocol = SecurityProtocolType.Tls12
ServicePointManager.Expect100Continue = True
Dim _urlAXS As String = "https://api.coingecko.com/api/v3/coins/axie-infinity" '&format=json"
Dim _req As System.Net.HttpWebRequest = System.Net.HttpWebRequest.Create(_urlAXS)
_req.Proxy = Nothing
_req.UserAgent = "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/98.0.4758.81 Safari/537.36"
Dim _resp As System.Net.HttpWebResponse = _req.GetResponse
Dim streamReader As System.IO.StreamReader = New System.IO.StreamReader(_resp.GetResponseStream())
Dim rank_source As String = streamReader.ReadToEnd
Dim _rankResults = JsonConvert.DeserializeObject(Of JsonResponse)(rank_source)
Dim vRank = _rankResults._rank
Dim vPrice = _rankResults._cPrice
Dim row As DataGridViewRow = Nothing
For Each item As DataGridViewRow In dgvMain.Rows
row = item
dgvMain.Rows(17).Cells(0).Value = vRank
dgvMain.Rows(17).Cells(4).Value = vPrice
Next
dgvMain.Refresh()
_runningThreads.Remove(Thread.CurrentThread)
Catch ex As Exception
End Try
End Sub
The Source in short:
"country_origin": "",
"genesis_date": null,
"contract_address": "0xbb0e17ef65f82ab018d8edd776e8dd940327b28b",
"sentiment_votes_up_percentage": 86.04,
"sentiment_votes_down_percentage": 13.96,
"market_cap_rank": 35,
"coingecko_rank": 282,
"coingecko_score": 34.249,
"developer_score": 0.0,
"community_score": 12.533,
"liquidity_score": 74.834,
"public_interest_score": 4.85,
"market_data": {
"current_price": {
"aed": 253.89,
"dot": 3.081598,
"eos": 26.36419,
"eth": 0.022493,
"eur": 60.44,
"gbp": 51.16,
}
}
"total_value_locked": null,
"mcap_to_tvl_ratio": null,
"fdv_to_tvl_ratio": null,
"roi": null,
SO under _cPrice I need to get the =>market_data => current_price => eur
Thank you for help.
Visual Studio has a cool feature called Paste JSON as Classes that can be found under Edit > Paste Special > Paste JSON as Classes. I cannot paste the example because the incoming payload is too large.
However, once you get the classes defined, you can then deserialize the object using the following:
Dim payload = JsonConvert.DeserializeObject(Of Rootobject)(rank_source)
Dim eurMarketDataCurrentPrice = payload.market_data.current_price.eur
Fiddle: https://dotnetfiddle.net/moVuMl
i used chromedriver but its slowly,i tried webbrowser but not worked.
My webpage is;
**https://coinmarketcap.com/converter/btc/usd/?amt=1 **
so
i want get of how much usd one bitcoin or more then one
Coinmarketcap uses it's own API service. You can use their API instead of using web page. Dont forget to add Newtonsoft library to your project from Nuget.
Dim btcAmount = 4
Dim tempcookies As New CookieContainer
Dim encoding As New UTF8Encoding
Dim postreq As HttpWebRequest = DirectCast(HttpWebRequest.Create("https://api.coinmarketcap.com/data-api/v3/tools/price-conversion?amount=" & btcAmount & "&convert_id=2781&id=1"), HttpWebRequest)
postreq.Method = "GET"
postreq.KeepAlive = True
postreq.CookieContainer = tempcookies
postreq.UserAgent = "Mozilla/5.0 (Windows; U; Windows NT 6.1; ru; rv:1.9.2.3) Gecko/20100401 Firefox/4.0 (.NET CLR 3.5.30729"
postreq.ContentType = "application/x-www-form-urlencoded"
postreq.Referer = "https://coinmarketcap.com"
Dim postresponse As HttpWebResponse
postresponse = DirectCast(postreq.GetResponse, HttpWebResponse)
tempcookies.Add(postresponse.Cookies)
Dim postreqreader As New StreamReader(postresponse.GetResponseStream())
Dim result As String = postreqreader.ReadToEnd
Dim json As JObject = JObject.Parse(result)
MessageBox.Show(json.Item("data").Item("quote")(0).Item("price"))
I have a json request in my vb.net desktop app project (.net framework 4.5.2). This codes working every time correcctly in my computerand i saw response json string every time.
But i tried run in other machines, not worked. Response is every time nothing in other machines. Any ideas on the reason for this?
Dim wcOrders As List(Of Woocomerce.Root)
Net.ServicePointManager.ServerCertificateValidationCallback = Function() True
System.Net.ServicePointManager.SecurityProtocol = System.Net.SecurityProtocolType.Tls12
Dim client = New RestClient("https://[??myhost??].com.tr/wp-json/wc/v3/orders?context=view")
client.Timeout = -1
Dim request = New RestRequest(Method.[GET])
request.AddHeader("Authorization", "Basic [MyAuth.Info]")
Dim response As IRestResponse = client.Execute(request)
wcOrders = JsonConvert.DeserializeObject(Of List(Of Woocomerce.Root))(response.Content)
If IsNothing(wcOrders) Then
MsgBox("not")
ElseIf wcOrders.Count = 0 Then
MsgBox("0")
MsgBox(response.Content)
Else
MsgBox(wcOrders.Count)
End If
I'm trying to parse property information from this link which produces a JSON response. I've used here JSON and VBA converter. However, when I run the script below, I get an error keyNotFoundError. I'm trying to parse the value of properties which is within features.
Public Sub parseJson()
Dim jsonObject As Object, oElem As Variant
Dim resp$, Url$, R&
Url = "https://torontolife.com/wp-content/themes/sjm-underscores/inc/neighbourhoods/2015/compiled.json"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", Url, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.182 Safari/537.36"
.send
resp = .responseText
End With
Set jsonObject = JsonConverter.parseJson(resp)
For Each oElem In jsonObject("features")
Debug.Print oElem("properties")
Next oElem
End Sub
I also get the same error when I try to like the following:
Sub Demo()
Dim Json As Object
JsonString = "[{""Entries"":[{""Name"": ""SMTH"",""Gender"": ""Male""}]}]"
JsonConverter.JsonOptions.AllowUnquotedKeys = True
Set Json = JsonConverter.ParseJson(JsonString)
Debug.Print Json(1)("Entries")
End Sub
I'm on Windows 7 (32 bit) and I'm using this library.
One more thing, they are valid JSON and I didn't encounter any error while parsing the same using Python.
Your code should be failing because oElem("properties") is a dictionary. Furthermore, within that dictionary there are a mixture of datatypes associated with the keys so you will need to test the type and handle appropriately. Or use one of the many readily available programs which will handle that and empty the entire json object for you.
Option Explicit
Public Sub ParseJson()
Dim jsonObject As Object, oElem As Variant
Dim resp$, Url$, R&
Url = "https://torontolife.com/wp-content/themes/sjm-underscores/inc/neighbourhoods/2015/compiled.json"
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", Url, False
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/88.0.4324.182 Safari/537.36"
.send
resp = .responseText
End With
Set jsonObject = JsonConverter.ParseJson(resp)
Dim key As Variant, propertyTypes As Scripting.Dictionary
Set propertyTypes = New Scripting.Dictionary
For Each oElem In jsonObject("features")
For Each key In oElem("properties")
Debug.Print key, vbTab, TypeName(oElem("properties")(key))
propertyTypes(key) = TypeName(oElem("properties")(key))
Next
Next oElem
'Review propertyTypes dict and/or immediate window print out
Stop
End Sub
I have to pull information from a MURAL board (design thinking tool, which is pretty much an online whiteboard). I need to pull the following information for the stickies:
https://app.mural.co/t/hanno1/m/hanno1/1488557783266/465baa38d35e95edc969a5ca9e2a8bb8b6f10310
Sticky Note Text
Sticky Note Attributes (Color, Size, Shape)
Sticky Note Location
Image links (and locations if possible)
I have created code that is not working. Nothing is being pulled. It pretty much skips straight from opening to quitting the browser.
Also how do I pull the actual HTML code to find the attributes/location?
Option Explicit
Public Sub GetInfo()
Dim ie As InternetExplorer, arr(), col
Set ie = New InternetExplorer
Set col = New Collection
With ie
.Visible = True
.navigate "https://app.mural.co/t/nextgencomms9753/m/nextgencomms9753/1536712668215/cd70107230d7f406058157a3bb8e951cedc9afc0"
While .Busy Or .readyState < 4: DoEvents: Wend
Dim listedItems As Object, item As Object, prices As Object, price As Object, j As Long
Set listedItems = .document.getElementsByClassName("widget-layer-inner")
For Each item In listedItems
Set prices = item.getElementsByClassName("Linkify")
ReDim arr(0 To prices.Length - 1) 'you could limit this after by redim to 0 to 0
j = 0
For Each price In prices
arr(j) = price.innerText
j = j + 1
Next
col.Add Array(item.getElementsByClassName("widgets-container") (0).innerText, arr)
Next
.Quit
Dim item2 As Variant, rowNum As Long
For Each item2 In col
rowNum = rowNum + 1
With ThisWorkbook.Worksheets("Sheet1")
.Cells(rowNum, 1) = Replace$(Trim$(item2(0)), Chr$(10), Chr$(32))
.Cells(rowNum, 2).Resize(1, UBound(item2(1)) + 1) = item2(1)
End With
Next
End With
End Sub
In general, I think using IE automation should be avoided where possible, especially if you can figure out a method to emulate this request via a web request.
A little background on this method
I'm submitting two web requests. One to get an authorization token, and another to get the the JSON from the page which populate the widgets on screen. I figured this out by studying the web requests sent back and forth between the client (me) and the server, and emulated those requests.The approach outlined below is pretty fast, about 2 seconds without URL decoding, and 10 seconds with decoding.
Things you'll need for this to work
Explicit Reference set to Microsoft XML v6.0
Explicit Reference set to Microsoft Scripting Runtime
The VBA-JSON project included into your project, get that here
Code
I split out token and json retrieval into two functions. What you get back from getJSON is a dictionary. This dictionary is somewhat nested, so you refer to items by key to traverse the dictionary down. E.g. MyDict(property1)(childPropertyOfproperty1)(childPropertyOf...) etc.
Here's the code.
Option Explicit
Public Sub SubmitRequest()
Const URL As String = "https://app.mural.co/t/hanno1/m/hanno1/1488557783266/465baa38d35e95edc969a5ca9e2a8bb8b6f10310"
Dim returnobject As Object
Dim widgets As Object
Dim widget As Variant
Dim WidgetArray As Variant
Dim id As String
Dim i As Long
Set returnobject = getJSON(URL, getToken(URL))
Set widgets = returnobject("widgets")
ReDim WidgetArray(0 To 7, 0 To 10000)
For Each widget In widgets
'Only add if a text item, change if you like
If returnobject("widgets")(widget)("type") = "murally.widget.TextWidget" Then
WidgetArray(0, i) = URLDecode(returnobject("widgets")(widget)("properties")("text"))
WidgetArray(1, i) = returnobject("widgets")(widget)("properties")("fontSize")
WidgetArray(2, i) = returnobject("widgets")(widget)("properties")("backgroundColor")
WidgetArray(3, i) = returnobject("widgets")(widget)("x")
WidgetArray(4, i) = returnobject("widgets")(widget)("y")
WidgetArray(5, i) = returnobject("widgets")(widget)("width")
WidgetArray(6, i) = returnobject("widgets")(widget)("height")
WidgetArray(7, i) = returnobject("widgets")(widget)("id")
i = i + 1
End If
Next
ReDim Preserve WidgetArray(0 To 7, i - 1)
With ThisWorkbook.Worksheets("Sheet1")
.Range("A1:H1") = Array("Text", "FontSize", "BackgroundColor", "X Position", "Y Position", "Width", "Height", "ID")
.Range(.Cells(2, 1), .Cells(i+ 1, 8)).Value = WorksheetFunction.Transpose(WidgetArray)
End With
End Sub
Public Function getJSON(URL As String, Token As String) As Object
Dim baseURL As String
Dim getRequest As MSXML2.XMLHTTP60
Dim URLParts As Variant
Dim jsonconvert As Object
Dim id As String
dim user as String
URLParts = Split(URL, "/", , vbBinaryCompare)
id = URLParts(UBound(URLParts) - 1)
user = URLParts(UBound(URLParts) - 2)
baseURL = Replace(Replace("https://app.mural.co/api/murals/{user}/{ID}", "{ID}", id), "{user}", user)
Set getRequest = New MSXML2.XMLHTTP60
With getRequest
.Open "GET", baseURL
.setRequestHeader "Authorization", "Bearer " & Token
.setRequestHeader "Referer", URL
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:64.0) Gecko/20100101 Firefox/64.0"
.send
Set getJSON = JsonConverter.ParseJson(.responseText)
End With
End Function
Public Function getToken(URL As String) As String
Dim getRequest As MSXML2.XMLHTTP60
Dim URLParts As Variant
Dim position As Long
Dim jsonconvert As Object
Dim Token As Object
Dim State As String
Dim User As String
Dim json As String
Dim referer As String
Dim id As String
Dim posturl As String
json = "{""state"": ""{STATE}""}"
posturl = "https://app.mural.co/api/v0/visitor/{user}.{ID}"
referer = "https://app.mural.co/t/{user}/m/{user}/{ID}"
URLParts = Split(URL, "/", , vbBinaryCompare)
position = InStrRev(URL, "/")
URL = Left$(URL, position - 1)
State = URLParts(UBound(URLParts))
id = URLParts(UBound(URLParts) - 1)
User = URLParts(UBound(URLParts) - 2)
json = Replace(json, "{STATE}", State)
posturl = Replace(Replace(posturl, "{user}", User), "{ID}", id)
referer = Replace(Replace(referer, "{user}", User), "{ID}", id)
Set getRequest = New MSXML2.XMLHTTP60
With getRequest
.Open "POST", posturl
.setRequestHeader "origin", "https://app.mural.co"
.setRequestHeader "Referer", referer
.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:64.0) Gecko/20100101 Firefox/64.0"
.setRequestHeader "Content-Type", "application/json; charset=utf-8"
.send json
Set jsonconvert = JsonConverter.ParseJson(.responseText)
End With
getToken = jsonconvert("token")
End Function
' from https://stackoverflow.com/a/12804172/4839827
Public Function URLDecode(ByVal StringToDecode As String) As String
With CreateObject("htmlfile")
.Open
.Write StringToDecode
.Close
URLDecode = .body.outerText
End With
End Function
Here's the output returned. There are other properties available, however this code is meant to just give you an idea how to pull this back.