Click on a href in VBA - vba

I want to click on the following link
I have the class name and the line code I was trying ot use is the following:
objIE.document.getElementByClassName("msDataText searchLink").Click
This may well be a very basic question.. any guidance
Thanks a lot

Not sure if it is a duplicate question.
A good function GetHTTPResult is already available from the link. You need to just pass the url for the GET request to fetch the data. For POST request (this function will not work), you need to make a POST request with postdata.
Also there is a sample for XMLHttpRequest at link
Function GetHTTPResult(sURL As String) As String
Dim XMLHTTP As Variant, sResult As String
Set XMLHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
XMLHTTP.Open "GET", sURL, False
XMLHTTP.Send
Debug.Print "Status: " & XMLHTTP.Status & " - " & XMLHTTP.StatusText
sResult = XMLHTTP.ResponseText
Debug.Print "Length of response: " & Len(sResult)
Set XMLHTTP = Nothing
GetHTTPResult = sResult
End Function

Related

REST API access via VBA returns "Invalid ID/Key" error

I am attempting to access the Appointments-Plus.com API via VBA code and am consistently being told I'm giving it an invalid site-id/key. I'm using Access from the Office365 version.
This is the relevant documentation for this API call.
When I use Postman to test out the API, I am able to successfully connect and I get data back. The URL Postman puts together is this:
https://ws.appointment-plus.com/Locations/GetLocations?Authorization:Basic=<site-ID>:<Key>&response_type=xml
My VBA code is this:
Public Sub RESTtestBigURL()
Dim responseType As String
responseType = "response_type=json"
Dim restRequest As WinHttp.WinHttpRequest
Set restRequest = New WinHttp.WinHttpRequest
Dim restResult As String
With restRequest
.Open "POST", "https://ws.appointment-plus.com/Locations/GetLocations?Authorization:Basic=<site-ID>:<Key>&response_type=xml", False
.Send
.WaitForResponse
Debug.Print ".ResponseText: " & .ResponseText
Debug.Print ".Status: " & .Status
Debug.Print ".StatusText: " & .StatusText
Debug.Print ".ResponseBody: " & .ResponseBody
End With
End Sub
I know that the first question is "are you sure you've got the <site-ID> and <key> correct???" Yes - I've copy/pasted the entire URL from Postman into my VBA code, and I've had another couple of pairs of eyeballs review it to confirm that they're still the same.
When I run that code, I get:
.ResponseText: <?xml version="1.0" encoding="utf-8" ?>
<APResponse>
<resource>customers</resource>
<action>getcustomers</action>
<request></request>
<result>fail</result>
<count>0</count>
<errors>
<error><![CDATA[Web Services authentication failed: invalid Site ID or API Key]]></error>
</errors>
</APResponse>
I've tried several other methods of accessing the API, all of which are giving me the same "Invalid ID/Key" error:
Public Sub SecondRESTtestMSXML()
Dim restRequest As MSXML2.XMLHTTP60
Set restRequest = New MSXML2.XMLHTTP60
With restRequest
.Open "GET", URL & REQUEST_GET_LOCATIONS, True
.SetRequestHeader "Authorization", "Basic" & SITE_ID & ":" & API_KEY
.SetRequestHeader "response_type", "xml"
.SetRequestHeader "Accept-Encoding", "application/xml"
.Send "{""response_type"":""JSON""&""location"":""582""}"
While .ReadyState <> 4
DoEvents
Wend
Debug.Print ".ResponseText: " & .ResponseText
Debug.Print ".Status: " & .Status
Debug.Print ".StatusText: " & .StatusText
Debug.Print ".ResponseBody: " & .ResponseBody
End With
End Sub
There is a suggestion that this is a duplicate of another question that was resolved by Base64-encoding. However, this method, while it wasn't explicit, shows that I have attempted that, too. I've added the Base64Encode function code that is called from here.
Public Sub RESTtest()
Dim restRequest As WinHttp.WinHttpRequest
Set restRequest = New WinHttp.WinHttpRequest
Dim restResult As String
With restRequest
.Open "POST", URL & REQUEST_GET_LOCATIONS, True
.SetRequestHeader "Authorization", "Basic " & SITE_ID & ":" & Base64Encode(API_KEY)
' Note call to Base64Encode() on this line ---------------- ----- ^^^^^^^^^^^^
.Option(WinHttpRequestOption_EnableRedirects) = False
.Send "{""response_type"":""JSON""}"
.WaitForResponse
Debug.Print ".ResponseText: " & .ResponseText
Debug.Print ".Status: " & .Status
Debug.Print ".StatusText: " & .StatusText
Debug.Print ".ResponseBody: " & .ResponseBody
End With
End Sub
Public Function Base64Encode(ByVal inputText As String) As String
Dim xmlDoc As Object
Dim docNode As Variant
Set xmlDoc = CreateObject("Msxml2.DOMDocument.3.0")
Set docNode = xmlDoc.createElement("base64")
docNode.DataType = "bin.base64"
docNode.nodeTypedValue = Stream_StringToBinary(inputText)
Base64Encode = docNode.Text
Set docNode = Nothing
Set xmlDoc = Nothing
End Function
Notes:
URL, REQUEST_GET_LOCATIONS, SITE_ID, and API_KEY are constants declared globally in this module for testing purposes. They, too, have all been copy/pasta'd and reviewed by several people for typos.
You may note that there are requests for responses in both XML and JSON - they're both giving me the same response.
I do have a support ticket open with Appt Plus, but I'm hoping I might get a faster response here.
Are there any obvious errors that anyone sees in this code? Are there any suggestions for other methods to attempt to call the API and get results? I've had a suggestion to write a DLL in C# and call that, however, I don't have the time to learn enough C# to make that happen, so switching languages isn't really an option here.
Additional notes:
I tried this using curl in a Powershell session, and it gives me the same result:
PS H:\> curl -method Post -uri "https://ws.appointment-plus.com/Locations/GetLocations?Authorization:Basic=<ID>:<key>&response_type=json"
The result:
StatusCode : 200
StatusDescription : OK
Content : {"resource":"locations",
"action":"getlocations",
"request":"",
"result":"fail",
"count":"0"
,"errors":[
"Web Services authentication failed: invalid Site ID or API ...
RawContent : HTTP/1.1 200 OK
Pragma: no-cache
Cache-Control: no-store, no-cache, must-revalidate, post-check=0, pre-check=0
Date: Mon, 26 Aug 2019 17:28:41 GMT
Expires: Thu, 19 Nov 1981 08:52:00 GMT
Set-Cooki...
Forms : {}
Headers : {[Pragma, no-cache], [Cache-Control, no-store, no-cache, must-revalidate, post-check=0,
pre-check=0], [Date, Mon, 26 Aug 2019 17:28:41 GMT], [Expires, Thu, 19 Nov 1981 08:52:00 GMT]...}
Images : {}
InputFields : {}
Links : {}
ParsedHtml : mshtml.HTMLDocumentClass
RawContentLength : 207
Per the exchanges in the comments, the main issue appears to be how the basic authorization header was being formed.
For future readers, the format for the authorization header is:
.SetRequestHeader "Authorization", "Basic " & Base64Encode(SITE_ID & ":" & API_KEY)
Also, another issue you may run into is related here. Linebreaks are inserted into the Base64 encoded string with the current approach, which won't play nice with most (if not all) APIs. A suggested fix for this would be something like:
Public Function Base64Encode(ByVal inputText As String, Optional removeBlankLines = True) As String
Dim xmlDoc As Object
Dim docNode As Variant
Set xmlDoc = CreateObject("Msxml2.DOMDocument.3.0")
Set docNode = xmlDoc.createElement("base64")
docNode.DataType = "bin.base64"
docNode.nodeTypedValue = Stream_StringToBinary(inputText)
Base64Encode = docNode.Text
Set docNode = Nothing
Set xmlDoc = Nothing
'remove blank line characters ASCII --> 10,13,10 + 13
If removeBlankLines Then Base64Encode = Replace(Replace(Replace(Base64Encode, vbCrLf, vbNullString), vbLf, vbNullString), vbCr, vbNullString)
End Function

Sending Photo to Telegram (API / Bot)

I send messages form Excel to telegram. It works nice.
But how can I send a photo? I don't understand it (https://core.telegram.org/bots/api#sendphoto)
Thanks for help!
My send Message:
Dim objRequest As Object
Dim strChatId As String
Dim strMessage As String
Dim strPostData As String
Dim strResponse As String
strChatId = Worksheets("Einstellungen").Cells(3, "AB")
strMessage = Report
APIcode = Worksheets("Einstellungen").Cells(2, "AB")
strPostData = "chat_id=" & strChatId & "&text=" & strMessage
Set objRequest = CreateObject("MSXML2.XMLHTTP")
With objRequest
.Open "POST", "https://api.telegram.org/" & APIcode & "/sendMessage?", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send (strPostData)
GetSessionId = .responseText
End With
If your code is working as-is for plain text messages then you should only need to make a couple changes to it.
You're probably currently using the API's sendMessage method, which takes the chat_id and text parameters.
You want to use the sendPhoto method, which tales the chat_id and photo parameters (but no text parameter).
So this is a bit of a shot in the dark since I've never used or heard of Telegram and I don't have a key, so I can't test it, but theoretically, you could send a photo from a URL like this:
Sub telegram_SendPhoto()
Const photoURL = "https://i.imgur.com/0eH6d1v.gif" 'URL of photo
Dim objRequest As Object, strChatId As String, APIcode As String
Dim strPostData As String, strResponse As String
strChatId = Worksheets("Einstellungen").Cells(3, "AB")
APIcode = Worksheets("Einstellungen").Cells(2, "AB")
strPostData = "chat_id=" & strChatId & "&photo=" & photoURL
Set objRequest = CreateObject("MSXML2.XMLHTTP")
With objRequest
.Open "POST", "https://api.telegram.org/" & APIcode & "/sendPhoto?", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send (strPostData)
strResponse = .responseText
End With
MsgBox strResponse
End Sub
Pass a file_id as String to send a photo that exists on the Telegram servers (recommended), pass an HTTP URL as a String for Telegram to get a photo from the Internet (above), or upload a new photo using multipart/form-data. More info on Sending Files ยป

Custom header with MSXML2.ServerXMLHTTP

I am currently trying to use MSXML2.ServerXMLHTTP to send a POST http request.
I need to add a custom header "Auth" so that my requests get authorized but it doesn't seem to work.
Here is the code for my post function:
Function post(path As String, authToken As String, postData As String) As String
Dim xhr As Object
Dim message As String
On Error GoTo error:
Set xhr = CreateObject("MSXML2.ServerXMLHTTP")
xhr.Open "POST", path, False
xhr.setRequestHeader "Content-Type", "application/json"
xhr.setRequestHeader "Auth", authToken
xhr.send postData
If xhr.Status = 200 Then
message = xhr.responseText
Else
message = xhr.Status & ": " & xhr.statusText
End If
Set xhr = Nothing
post = message
error:
Debug.Print "Error " & Err.Number; ":" & Err.Description
End Function
And I end up with "Error -2147012746 Requested Header was not found" (The message is actually translated since I use a different language on my computer).
However I didn't have this problem with the "Microsoft.XMLHTTP" Object.
Am I doing something wrong ?
Thank you for your time.
Try changing the call to SetRequestHeader to use a string literal. I duplicated the problem when authToken does not have a value set.
Change from this
xhr.setRequestHeader "Auth", authToken
To this
xhr.setRequestHeader "Auth", "testdatahere"

Exchanging Authorization Code for Access Token for Google Calendar API with VBA and Oauth2

After successfully obtaining the authorization code, I am having trouble exchanging it for an access token and refresh token while trying to access the Google Calendar API. I get Error 404 Not Found. Here is my code:
Dim getTokenUrl As String
getTokenUrl = "https://accounts.google.com/o/auth2/token"
Dim getTokenBody As String
getTokenBody = "code=" & code & _
"&redirect_uri=urn:ietf:wg:oauth:2.0:oob" & _
"&client_id=xxxxxxx-xxxxxxxx.apps.googleusercontent.com" & _
"&client_secret={myLittleSecret}" & _
"&grant_type=authorization_code"
Dim Http As MSXML2.XMLHTTP60
Set Http = CreateObject("MSXML2.XMLHTTP.6.0")
With Http
.Open "POST", getTokenUrl, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send(getTokenBody)
End With
Do While Http.ReadyState <> 4
Loop
Debug.Print Http.responseText
I have also tried putting everything in the url parameter of the .Open method and nothing in the .Send method:
Dim getTokenUrl As String
getTokenUrl = "https://accounts.google.com/o/oauth2/token&code=" & code & "&client_id=xxxxxx-xxxxxx.apps.googleusercontent.com&client_secret={myLittleSecret}&redirect_uri=urn:ietf:wg:oauth:2.0:oob&grant_type=authorization_code"
Dim Http As MSXML2.XMLHTTP60
Set Http = CreateObject("MSXML2.XMLHTTP.6.0")
With Http
.Open "POST", getTokenUrl, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send("")
End With
I have tried using WinHttp.WinHttpRequest instead of MSXML2.XMLHTTP.
I have tried using http://localhost instead of urn:ietf:wg:oauth:2.0:oob.
I have tried making http://localhost and urn:ietf:wg:oauth:2.0:oob url encoded.
All give Error 404 Not Found.
Can someone help point me in the right direction?
Finally figured it out--
The URL I was using was wrong--a one-letter type-o /forehead-slap/
instead of:
Dim getTokenUrl As String
getTokenUrl = "https://accounts.google.com/o/auth2/token"
it should have been:
Dim getTokenUrl As String
getTokenUrl = "https://accounts.google.com/o/oauth2/token"
note the oauth2 instead of just auth2
Geesh. Sometimes I just need more sleep.
Incidentally, I could only get it to work when I put only the base URL in the .Open request and the parameters in the .send() (rather than stringing them all together in to one URL and "POST"ing it).
Working like a charm now!

VBA WinHttp request:parameter is incorrect (error 80070057)

I have this script to automatically fetch Google Analytics results, it has worked fine for over a year. All of the sudden it stopped working.
I'm getting error 80070057: parameter is incorrect
This is the code. And yes, I'm using a proxy.
The error happens at the first SetRequestHeader
Dim WinHttpReq As WinHttp.WinHttpRequest
' Create an instance of the WinHTTPRequest ActiveX object.
Set WinHttpReq = New WinHttpRequest
' Assemble an HTTP Request.
WinHttpReq.Open "GET", url, False
WinHttpReq.SetProxy HTTPREQUEST_PROXYSETTING_PROXY, "http://webproxy.vum.be:8080"
WinHttpReq.SetRequestHeader "Authorization", "GoogleLogin Auth=" & auth
WinHttpReq.SetRequestHeader "GData-Version", 2
' Send the HTTP Request.
WinHttpReq.Send
' Put status and content type into status text box.
strStatus = WinHttpReq.STATUS & " - " & WinHttpReq.StatusText
'Debug.Print "Status: " & strStatus
If Body = True Then
get_url_google = WinHttpReq.ResponseText
Else
get_url_google = strStatus
End If
It was Google's fault. The "auth" variable was misformed, during the authentication procedure google was asking for a captcha.