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
Related
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
I have been able to launch the website and input the value but I'm not able to press enter to get the output value. It's an online calculator that allows you to see the temperature of a refrigerant while inputting a pressure. the output(temperature) is supposed to change when you input(pressure), however when I do it the output(temperature) stays the same while I'm able to change the input(pressure). could you tell me what might be the reason for this? is the website blocking my input? i get this error: (run-time erro91: object variable or with block variable not set)
when i run the code for this code "ht.getElementById("pressure").Value = "20""
enter image description here
here is my code:
Sub test()
Dim ie As InternetExplorer
Dim ht As HTMLDocument
Dim temp As Object
Dim press As Object
Set ie = New InternetExplorer
ie.Visible = True
ie.navigate ("https://reftools.danfoss.com/spa/tools/ref-slider#/")
Do Until ie.readyState = READYSTATE_COMPLETE
DoEvents
Loop
Set ht = ie.document
'input
ht.getElementById("pressure").Value = "20"
'Set temp = ht.getElementsByClassName("temperature")
'Set press = ht.getElementsByClassName("pressure")
'i = 1
'For Each te In temp
'Sheet1.Cells(i, 1).Value = te.innerText
'i = i + 1
'Next
End Sub
There is an API you can call to perform the same conversion. Below is an example implementation of calling that API using a custom function which accepts the pressure as input and returns the temperature in Celsius.
Option Explicit
Public Function GetTempFromPressure(ByVal pressure As Double) As Double
Dim body As String
body = "{""pressure"":""" & pressure & """,""refId"":""r404a"",""temperatureUnit"":""celsius"",""pressureUnit"":""bar"","
body = body & """pressureReferencePoint"":""absolute"","
body = body & """pressureCalculationPoint"":""dew"",""gaugeType"":""dry"",""altitudeInMeter"":0}"
With CreateObject("MSXML2.XMLHTTP")
.Open "POST", "https://reftools.danfoss.com/api/ref-slider/temperature?refId=r404a", False
.setRequestHeader "content-type", "application/json; charset=utf-8"
.send body
GetTempFromPressure = CDbl(.responseText)
End With
End Function
Public Sub test()
MsgBox GetTempFromPressure(20)
End Sub
I am using the VBA code to extract information from a website into excel cells, and the numerical information is fine but I have a problem with text strings. I am mostly extracting information from Georgian websites, and the texts with the Georgian language are not properly displayed in excel, so I was wondering if there is any chance (code or something else) I could convert these symbols into proper language.
Sub GetData()
Dim request As Object
Dim response As String
Dim html As New HTMLDocument
Dim website As String
Dim price As Variant
Dim address As Variant
Dim x As Integer
Dim y As Range
x = 1
Do Until x = 9
Set y = Worksheets(1).Range("A21:A200"). _
Find(x, LookIn:=xlValues, lookat:=xlWhole)
website = "https://www.myhome.ge/ka/pr/11247371/iyideba-Zveli-ashenebuli-bina-veraze-T.-WoveliZis-qucha"
' Create the object that will make the webpage request.
Set request = CreateObject("MSXML2.XMLHTTP")
' Where to go and how to go there.
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.
html.body.innerHTML = response
' Get info from the specified element on the page.
address = html.getElementsByClassName("address").Item(0).innerText
price = html.getElementsByClassName("d-block convertable").Item(0).innerText
y.Offset(0, 1).Value = address
y.Offset(0, 5).Value = price
x = x + 1
Loop
End Sub
This is the code that I took from a youtube video (https://www.youtube.com/watch?v=IOzHacoP-u4) and slightly modified, and it works, I just have a problem with how excel displays the characters in text strings.
For your issue in the question
Remove this line response = StrConv(request.responseBody, vbUnicode) as it's not required.
Change html.body.innerHTML = response to html.body.innerHTML = request.responseText.
For your issue in comment
To retrieve the ID of the property, it can be retrieved from the class id-container, you will need to perform some string processing though to remove the extract :
propertyID = Trim$(Replace(html.getElementsByClassName("id-container")(0).innerText, ":", vbNullString))
Note: You should try to avoid declaring variable as Variant. innerText property returns a String datatype so you should declare address and price as String.
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.