I have setup remote temp readings that update in excel every second.
When the internal temp reading in Col C equals the external temp in col E, the corresponding row in col G will highlight as a match and display the property and room where the match exists.
I would like to know if it is possible for VBA code to be applied to do the following:
Scan/loop Column G and if the row is not blank to take the output and send via telegram as an alert system.
As the temperature moves a lot I would only like to be alerted once every hour but would prefer to leave the possibility of having this as a variable setting eg. every 5,10,15.20 mins linked to the excel document should I wish to change it. Any help would be most appreciated.
Any help would be most appreciated.
I have used the code so far for sending the code on telegram, my only issue is being able to create a loop on column G to find any non blank cells within a variable timeframe and linking it to send the message via telegram.
Telegram code:
Sub Main_Routine()
''' The first parameter is the recipient's number (NOT the gateway number), including the country code.
''' The second paramter is the content of the message.
TelegramMessage_Send "12025550108", "Alert message here"
End Sub
Sub TelegramMessage_Send(ByRef strNumber As String, ByRef strMessage As String)
Dim CLIENT_ID As String, CLIENT_SECRET As String, API_URL As String
Dim strJson As Variant
Dim sHTML As String
Dim oHttp As Object
''' TODO: Replace the following with your gateway instance ID, your Premium client ID and secret:
INSTANCE_ID = "YOUR_INSTANCE_ID_HERE"
CLIENT_ID = "YOUR_CLIENT_ID_HERE"
CLIENT_SECRET = "YOUR_CLIENT_SECRET_HERE"
API_URL = "http://api.whatsmate.net/v1/telegram/single/message/" & INSTANCE_ID
strJson = "{""number"": """ & strNumber & """, ""message"": """ & strMessage & """}"
Set oHttp = CreateObject("Msxml2.XMLHTTP")
oHttp.Open "POST", API_URL, False
oHttp.setRequestHeader "Content-type", "application/json"
oHttp.setRequestHeader "X-WM-CLIENT-ID", CLIENT_ID
oHttp.setRequestHeader "X-WM-CLIENT-SECRET", CLIENT_SECRET
oHttp.Send strJson
sHTML = oHttp.ResponseText
MsgBox sHTML
End Sub
Related
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 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.
Request your help to solve the below issue,I am struck for two days,
vba run time error '- 2146697208 (800c0008 )': The download of the specified resource has failed
This is my code for your reference:
Sub telebot15status155555()
'Program Excel Messeger
' Purpose : Send Message to Telegram
' Author : John Eswin Nizar
' Date : 09 October 2017
Dim objRequest As Object
Dim strChatId As String
Dim strMessage1 As String
Dim strMessage2 As String
Dim strPostData As String
Dim strResponse As String
strChatId = "#messstatus"
strMessage1 = ""
strMessage2 = Now()
'strMessage = "hallo"
strPostData = "chat_id=" & strChatId & "&text=" & strMessage1 & strMessage2
Set objRequest = CreateObject("MSXML2.XMLHTTP")
With objRequest
.Open "POST", "https://api.telegram.org/sendMessage?", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send (strPostData)
GetSessionId = .responseText
MsgBox GetSessionId
End With
End Sub
My advice here is to perform this API call in Chrome with DevTools open. Or access the page, where this happens, and find the Request on the 'Network' tab. Then look at the headers.
debug.print strPostData is returning:
chat_id=#messstatus&text=2/7/2020 9:40:23 AM
That format does not look correct for an API that is form-urlencoded. You need to see what the website is actually sending and receiving in the DevTools in order to replicate it.
IOW, The resource isn't found because the API is incorrectly formatted. From the base api, it looks like its actually a QueryString too because it ends with ? which might mean you have to url-encode format the POST Data into the QueryString for the main HTTP request. Have a look here: Pass Parameters in VBA HTTP Post Request
I created an Excel VBA function for geocoding address. It worked last year.
Google started a new billing process and the code does not work.
input:address
output: Lat, Long
Function getGoogleMapsGeocode(sAddr As String) As String
Dim xhrRequest As XMLHTTP60
Dim sQuery As String
Dim domResponse As DOMDocument60
Dim ixnStatus As IXMLDOMNode
Dim ixnLat As IXMLDOMNode
Dim ixnLng As IXMLDOMNode
getGoogleMapsGeocode = ""
Set xhrRequest = New XMLHTTP60
sQuery = "https://maps.googleapis.com/maps/api/geocode/xml?sensor=false&address="
sQuery = sQuery & Replace(sAddr, " ", "+") & "&key=MY-API-KEY"
xhrRequest.Open "GET", sQuery, False
xhrRequest.send
Set domResponse = New DOMDocument60
domResponse.LoadXML xhrRequest.responseText
Set ixnStatus = domResponse.SelectSingleNode("//status")
If (ixnStatus.Text <> "OK") Then
Exit Function
End If
Set ixnLat = domResponse.SelectSingleNode("/GeocodeResponse/result/geometry/location/lat")
Set ixnLng = domResponse.SelectSingleNode("/GeocodeResponse/result/geometry/location/lng")
getGoogleMapsGeocode = ixnLat.Text & ", " & ixnLng.Text
End Function
I got it to work by changing one old server key but that brought another question.
I recently registered two API key which do not work. However, the old server key works. What is the difference between API key and server key?
Geocoding VBA Excel 2010
Thanks to my brother Edu for your help!
Option Explicit
Function GetCoordinates(Address As String) As String
'This function returns the latitude and longitude of a given address using the Google Geocoding API.
'The function uses the "simplest" form of Google Geocoding API (sending only the address parameter),
'so, optional parameters such as bounds, language, region and components are NOT used.
'In case of multiple results (for example two cities sharing the same name), the function
'returns the FIRST OCCURRENCE, so be careful in the input address (tip: use the city name and the
'postal code if they are available).
'NOTE: As Google points out, the use of the Google Geocoding API is subject to a limit of 40,000
'requests per month, so be careful not to exceed this limit. For more info check:
'https://cloud.google.com/maps-platform/pricing/sheet
'In order to use this function you must enable the XML, v3.0 library from VBA editor:
'Go to Tools -> References -> check the Microsoft XML, v3.0.
'If you don't have the v3.0 use any other version of it (e.g. v6.0).
'2018 Update: In order to use this function you will now need a valid API key.
'Check the next link that guides you on how to acquire a free API key:
'https://www.myengineeringworld.net/2018/02/how-to-get-free-google-api-key.html
'2018 Update 2 (July): The EncodeURL function was added to avoid problems with special characters.
'This is a common problem with addresses that are from Greece, Serbia, Germany and other countries.
'Written By: Christos Samaras
'Date: 12/06/2014
'Last Updated: 09/08/2018
'E-mail: xristos.samaras#gmail.com
'Site: https://www.myengineeringworld.net
'-----------------------------------------------------------------------------------------------------
'Declaring the necessary variables.
'The first 2 variables using 30 at the end, corresponding to the "Microsoft XML, v3.0" library
'in VBA (msxml3.dll). If you use any other version of it (e.g. v6.0), then declare these variables
'as XMLHTTP60 and DOMDocument60 respectively.
Dim ApiKey As String
Dim Request As New XMLHTTP30
Dim Results As New DOMDocument30
Dim StatusNode As IXMLDOMNode, LatitudeNode As IXMLDOMNode, LongitudeNode As IXMLDOMNode
'Set your API key in this variable. Check this link for more info:
'https://www.myengineeringworld.net/2018/02/how-to-get-free-google-api-key.html
'****************************************************************************************************************
ApiKey = "Your API Key goes here!"
'example: ApiKey = "lxI800lklv3sdf3v5F6........."
I have a excel sheet with a list of users, is there a way i could send this list one by one to a internal website which accepts the user name in a text box to check if this user exist and print the output to a new column ?
When the user is found it will print the user details.
When not found it will tell not found.
Should be possible with something similar to this:
Function testHttpGet()
Dim oHttp As Object
Set oHttp = CreateObject("Microsoft.XMLHTTP")
MyUrl = "http://10.0.21.130/test.php?name=mikeqq"
oHttp.Open "GET", MyUrl, False
oHttp.send
'MsgBox oHttp.Status
If oHttpPost.Status < 300 Then
SomeVar = oHttpPost.responseText
MsgBox SomeVar
End If
End Function