I'm very new to API coding but I have created an API Code that inputs pressure and outputs temperature for a specific refrigerant on a website. However, I can only call for one refrigerant at a time, I was wondering if it is possible to create a string with all the refrigerant id (refId) numbers, so the API code could run through all of them in one long run?
Option Explicit
Public Function GetPressureFromTemp(ByVal Temperature As Double) As Double
Dim body As String
body = "{""Temperature"":""" & Temperature & """,""refId"":""r13"",""temperatureUnit"":""fahrenheit"",""pressureUnit"":""psi"","
body = body & """pressureReferencePoint"":""gauge"","
body = body & """pressureCalculationPoint"":""bubble"",""gaugeType"":""dry"",""altitudeInMeter"":0}"
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "https://reftools.danfoss.com/api/ref-slider/Pressure?refId=r13", False
.setRequestHeader "content-type", "application/json; charset=utf-8"
.send body
GetPressureFromTemp = CDbl(.responseText)
End With
End Function
Public Sub test()
Dim n As Double
Dim a As Double
a = 4984
n = -150.8
Do Until n >= 74.93
n = n + 0.1
'Debug.Print GetPressureFromTemp(n)
Range("J" & a) = GetPressureFromTemp(n)
a = a + 1
Loop
End Sub
I'm not sure how to loop through each ref ID, however I have the whole list containing the refrigerant id
Related
I have a function in excel to extract travel distance using Google Maps API that looks like this: Function TRAVELDISTANCE(origin, destination, apikey)
Dim strUrl As String
strUrl = "https://maps.googleapis.com/maps/api/directions/json?origin=" & origin & "&destination=" & destination & "&key=" & apikey
Set httpReq = CreateObject("MSXML2.XMLHTTP")
With httpReq
.Open "GET", strUrl, False
.Send
End With
Dim response As String
response = httpReq.ResponseText
Dim parsed As Dictionary
Set parsed = JsonConverter.ParseJson(response)
Dim KM As Long
Dim leg As Dictionary
For Each leg In parsed("routes")(1)("legs")
meters = meters + leg("distance")("value")
Next leg
TRAVELDISTANCE = meters
End Function
Does anyone know how I can edit this to give me the value "Ferry" if the route includes a ferry?
Maybe this.
https://www.google.com/maps/dir/50.8971936,-1.397307/50.8653945,-1.3991824/#50.8705321,-1.4018442,16z/am=t/data=!4m6!4m5!3e2!6m3!1i0!2i0!3i7
F2 to see the code behind the page.
I'm trying to extract values from a website in a loop. it's basically inputing the value in pressure and it outputs the temperature value. I have the full code and it is working but only when the loop is in n=n+1 but when I change the loop into n=n+0.1 (I'm trying to extract more data) the output is the same value every time even though a 0.1 on the website changes the output value and the excel code starts to crash after few seconds. could please tell me what might be the reason for this?
Option Explicit
Public Function GetPressureFromTemp(ByVal temperature As Double) As Double
Dim body As String
body = "{""temperature"":""" & temperature & """,""refId"":""r410a"",""temperatureUnit"":""fahrenheit"",""pressureUnit"":""psi"","
body = body & """pressureReferencePoint"":""gauge"","
body = body & """pressureCalculationPoint"":""bubble"",""gaugeType"":""dry"",""altitudeInMeter"":0}"
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "https://reftools.danfoss.com/api/ref-slider/pressure?refId=r410a", False
.setRequestHeader "content-type", "application/json; charset=utf-8"
.send body
GetPressureFromTemp = CDbl(.responseText)
End With
End Function
Public Sub test()
Dim n As Integer
n = 20
Do Until n = 20.1
n = n + 0.1
Debug.Print GetPressureFromTemp(n)
Loop
End Sub
To make sure an address is always formatted the same way (which I will use in another VBA Sub), I'm trying to use the Google Places API in combination with a created VBA function.
The query works in the browser but not from the created function.
The working API (temporary API-key added) with a random address: https://maps.googleapis.com/maps/api/place/findplacefromtext/json?fields=formatted_address%2Cname%2Crating%2Copening_hours%2Cgeometry&input=Coendersweg%202&inputtype=textquery&key=API_KEY
It gives "Formatted_Address" which I'd like to show up as the result of the function.
Example result of random address:
Coendersweg 2, 9722GE Groningen / [Streetname number, Zipcode City]
If it's possible to make resulting address have the zip code (9722 GE) formatted as "9722GE" and the country ", Nederland" not show up that would be even better.
VBA code I have so far:
Function FindAddress(address, APIKEY)
Dim strURL As String
strURL = "https://maps.googleapis.com/maps/api/place/findplacefromtext/" & _
"json?fields=formatted_address%2Cname%2Crating%2Copening_hours%2Cgeometry&input=" _
& address & "&inputtype=textquery&key=" & APIKEY
Set httpReq = CreateObject("MSXML2.XMLHTTP")
With httpReq
.Open "GET", strURL, False
.Send
End With
Dim Response As String
Response = httpReq.ResponseText
Dim parsed As Dictionary
Set parsed = JsonConverter.ParseJson(Response)
Dim FoundAddress As String
FoundAddress = (formatted_address)
FindAddress = FoundAddress
I've the "JsonConverter.bas" from https://github.com/VBA-tools/VBA-JSON as a module inside my VBA.
Most of the code is borrowed from the following YouTube video. I made some tweaks to work with Google Places API instead of Google Directions API:
https://www.youtube.com/watch?v=_P2lj4yHNu4.
Here's a method that will return the formatted_address field. You can return other fields if you prefer -- the modifications should be obvious.
Note that I used early binding, but you can use late binding if you prefer.
Run against your input, => Coendersweg 2, 9722 GE Groningen, Netherlands
Option Explicit
Function getAddress(S As String)
Const API As String = "key=YOUR_API_KEY"
Const sURL1 As String = "https://maps.googleapis.com/maps/api/place/findplacefromtext/json?fields=formatted_address"
Const sURL2 As String = "input="
Const sURL3 As String = "inputtype=textquery"
Dim sAddr As String
Dim sURL() As String
Dim sLocation As String
Dim xhrRequest As XMLHTTP60
Dim strJSON As String, JSON As Object
sAddr = Replace(S, " ", "%20")
'Many ways to create the URL to send
ReDim sURL(3)
sURL(0) = sURL1
sURL(1) = sURL2 & sAddr
sURL(2) = sURL3
sURL(3) = API
Set xhrRequest = New XMLHTTP60
With xhrRequest
.Open "Get", Join(sURL, "&"), False
.Send
strJSON = .ResponseText
End With
Set JSON = ParseJson(strJSON)
If Not JSON("status") = "OK" Then
MsgBox "Status message: " & JSON("status")
Exit Function
End If
'might need to check if more than one candidate is returned
getAddress = JSON("candidates")(1)("formatted_address")
End Function
If you want to have the format different from what is shown, I suggest you use the Places api to return the place_id. You can then feed that value into the Place Details to return the address_components and format the address however you prefer.
I am using the following code in Excel to calculate the travel distance between various places. In this calculation it calculates the "driving" directions.
I am however also looking for the public transport directions. I've been puzzling how to change the code to change the travel mode (https://developers.google.com/maps/documentation/directions/overview#TravelModes), but I cant get it to work. Does anybody have an idea how to incorporate this?
Function TRAVELTIME(origin, destination, apikey)
Dim strUrl As String
strUrl = "https://maps.googleapis.com/maps/api/directions/json?origin=" & origin & "&destination=" & destination & "&key=" & apikey
Set httpReq = CreateObject("MSXML2.XMLHTTP")
With httpReq
.Open "GET", strUrl, False
.Send
End With
Dim response As String
response = httpReq.ResponseText
Dim parsed As Dictionary
Set parsed = JsonConverter.ParseJson(response)
Dim seconds As Integer
Dim leg As Dictionary
For Each leg In parsed("routes")(1)("legs")
seconds = seconds + leg("duration")("value")
Next leg
TRAVELTIME = seconds
I have created an application that scrapes data from a website.
The code runs as expected for a small number of iterations.
However, when the code is executed multiple times it crashes with an Automation Error.
My goal is to get daily auction results from this website, for multiple "border directions" and multiple "dates".
Having inspected the HTTP requests that are being sent when browsing the site I have been able to automate them and get the data I'm interested in, as follows:
Sub seecao()
Dim request As New WinHttpRequest
Dim htmlDoc As New MSHTML.HTMLDocument
Dim tableTest As HTMLTable
Dim rowHTML As HTMLTableRow
Dim cellHTML As HTMLTableCell
Dim requestURL As String
Dim responseJSON As Object
Dim reqBody As String
Dim reqResponse As String
Dim seecaoBordersArray As Variant
Dim areaOut As String
Dim areaIn As String
Dim i As Long
Dim j As Long
Dim k As Long
Dim tempRng As Range
seecaoBordersArray = ThisWorkbook.Worksheets("Help").Range("seecaoBordersRng")
requestURL = "http://seecao.com/views/ajax"
Application.ScreenUpdating = False
For k = LBound(seecaoBordersArray, 1) To UBound(seecaoBordersArray, 1) Step 1
areaOut = seecaoBordersArray(k, 1)
areaIn = seecaoBordersArray(k, 2)
Set tempRng = ThisWorkbook.Worksheets("seecao").Cells.Find(What:=areaOut + areaIn, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
i = tempRng.Offset(2, 0).Row
j = tempRng.Offset(2, 0).Column
reqBody = ThisWorkbook.Worksheets("Help").Range("A1:A1") + Format(Date + 1, "yyyy-mm-dd") + ThisWorkbook.Worksheets("Help").Range("A2:A2") + areaOut + "+-+" + areaIn + ThisWorkbook.Worksheets("Help").Range("A3:A3")
With request
.Open "POST", requestURL, False
.setRequestHeader "Host", "seecao.com"
.setRequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
.setRequestHeader "Referer", "http://seecao.com/daily-results"
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
.send reqBody
reqResponse = .responseText
End With
Set responseJSON = JsonConverter.ParseJson(reqResponse)
htmlDoc.body.innerHTML = responseJSON(3)("data")
Set tableTest = htmlDoc.getElementsByTagName("table")(0)
For Each rowHTML In tableTest.Rows
If rowHTML.Cells(0).innerText <> "Date " Then
ThisWorkbook.Worksheets("seecao").Cells(i, j) = rowHTML.Cells(2).innerText
ThisWorkbook.Worksheets("seecao").Cells(i, j + 1) = rowHTML.Cells(5).innerText
i = i + 1
End If
Next rowHTML
Next k
Application.ScreenUpdating = True
End Sub
The body of the HTTP request consists of various parameters which form a huge string. I have split this string in 3 parts to be able to edit the "date" and "border direction" and i've stored these 3 parts in ThisWorkbook.Worksheets("Help").Range("A1:A1"), ThisWorkbook.Worksheets("Help").Range("A2:A2") and ThisWorkbook.Worksheets("Help").Range("A3:A3").
All possible "border directions" are stored in a 2x2 named range seecaoBordersArray. The code loops through this range, produces the corresponding request body, sends the request and gets the response.
The response is in JSON format. The part of the response in which I'm interested is an HTML table located in the JSON string.
The JSON string is then parsed to get the HTML table. Finally the HTML table is parsed and the data of interest are being written on a worksheet.
As I said in the beginning of this post, the code works as expected most of the times, but it randomly crashes with an Automation Error depending on how many iterations are being executed.
For example it never crashes when I only execute it for 2 combinations of "borders directions".
It seems to me like some kind of performance issue rather than a bug.
Any suggestions on how to improve performance and avoid these crashes would be greatly appreciated.