I am trying to call an API for sending SMS from Excel Macro.
I tried sending using MSXML2.XMLHTTP it sends SMS successfully from my system, But in client's system it is giving error "An error occurred in the secure channel support".
Set httpObject = CreateObject("MSXML2.XMLHTTP")
sURL = "https://api.xxx.in/send/?apiKey=" & sAPIKey & "&sender=" & sSenderID & "&numbers=" & sMobileNo & "&message=" & sMsg
httpObject.Open "POST", sURL, False
httpObject.Send
sGetResult = httpObject.ResponseText
I tried second method like
Set winHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
myURL = "https://api.xxx.in/send/?"
postData = "apikey=" & sAPIKey & "&message=" & sMsg & "&numbers=" & sMobileNo & "&sender=" & sSenderID
winHttpReq.Open "POST", myURL, False
winHttpReq.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
winHttpReq.Send (postData)
SendSMS = winHttpReq.ResponseText
On line winHttpReq.SetRequestHeader it gives error "An error occured in the secure channel support" on my system. As per suggestions I enabled all TLS versions but still the same error. I am using Win 7 and excel 6.5.Somewhere i read to add the ciphers to the servers. I have no idea how to do that. I guess issue is somewhere else.
Can anyone pls help. I will prefer to use the 2nd method.
Thanks
Related
I have implemented a Sharepoint API connect/authorize/download functionality in an Excel workbook using VBA - see my implementation snippet below:
base_url = "SP URL/_api/web/"
end_url = "GetFileByServerRelativeUrl('" & endpoint_url
url = base_url & end_url & filepath & "')/$value"
HttpRequest.Open "GET", url
HttpRequest.setRequestHeader "Authorization", "Bearer " & auth_token
HttpRequest.Send
sresult = HttpRequest.responseText
sObject = HttpRequest.responseBody
filepath = Replace(filepath, "%20", " ")
filestring = Replace(filestring, "%20", " ")
'MsgBox HttpRequest.Status
If HttpRequest.Status = 200 Then
'MsgBox HttpRequest.responseBody
Set MyStream = CreateObject("ADODB.Stream")
MyStream.Open
MyStream.Type = 1
MyStream.Write HttpRequest.responseBody
MyStream.SaveToFile filestring, 2
MyStream.Close
Else
MsgBox HttpRequest.Status
MsgBox "Error - Connection to server failed"
End If
I am struggling with how to adapt this for an upload use case.
From reading the SP API docs I can see that I need to adjust the url endpoint to /GetFolderByServerRelativeUrl('/Library Name/Folder Name')/Files/add(url='example.txt',overwrite=true)
I am however unsure on the adaptation of the HttpRequest part, is it as simple as changing the `HttpRequest.Open "GET", url' to 'HttpRequest.Open "SEND", url' and then alterating the below part?
Set MyStream = CreateObject("ADODB.Stream")
MyStream.Open
MyStream.Type = 1
MyStream.Write HttpRequest.responseBody
MyStream.SaveToFile filestring, 2
MyStream.Close
I've been at this for a few hours now, have tried to rewrite the MyStream part of the script but I am really unfamiliar with constructing this type of upload request.
Have attempted to write a SEND version of the function but am unclear on the full scope of changes I need to make.
For upload use .LoadFromFile and then .read on the ADO stream.
' read file as binary
Dim ado As Object
Set ado = CreateObject("ADODB.Stream")
With ado
.Type = 1 'binary
.Open
.LoadFromFile filepath & filename
.Position = 0
End With
' request
Dim client As Object
Set client = CreateObject("MSXML2.XMLHTTP.6.0")
With client
.Open "POST", Url, False
.setRequestHeader "Authorization", "Bearer " & AUTH_TOKEN
.send ado.read
ado.Close
Debug.Print .responseText
If .Status = 200 Then '200 = OK
MsgBox ("Upload completed successfully")
Else
MsgBox .Status & ": " & .statusText
End If
End With
I'm working on my master's thesis and really need your help with some distance calculations.
I am really struggling with some code I found online in order to calculate the distance between several addresses (~10k pairs). I tried two different codes from two websites, and they both give me an error.
I already created my own Google API, and activated billing (using the URL test actually works for me) and tried some suggestions from other forums.
1. Approach
Found on: https://analystcave.com/excel-calculate-distances-between-addresses/
Code
'Calculate Google Maps distance between two addresses
Public Function GetDistance(start As String, dest As String)
Dim firstVal As String, secondVal As String, lastVal As String
firstVal = "http://maps.googleapis.com/maps/api/distancematrix/json?origins="
secondVal = "&destinations="
lastVal = "&mode=car&language=pl&sensor=false&key=YOUR_KEY"
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = firstVal & Replace(start, " ", "+") & secondVal & Replace(dest, " ", "+") & lastVal
objHTTP.Open "GET", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send ("")
If InStr(objHTTP.responseText, """distance"" : {") = 0 Then GoTo ErrorHandl
Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = """value"".*?([0-9]+)": regex.Global = False
Set matches = regex.Execute(objHTTP.responseText)
tmpVal = Replace(matches(0).SubMatches(0), ".", Application.International(xlListSeparator))
GetDistance = CDbl(tmpVal)
Exit Function
ErrorHandl:
GetDistance = -1
End Function
Every time I'm applying the formula, I get a "-1" i.e. error message.
2. Approach
Found on: https://syntaxbytetutorials.com/excel-function-to-calculate-distance-using-google-maps-api-with-vba/
Here I also added VBA-JSON and activated references as suggested by the author.
Code
' Returns the number of seconds it would take to get from one place to another
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 meters As Integer
Dim leg As Dictionary
For Each leg In parsed("routes")(1)("legs")
meters = meters + leg("distance")("value")
Next leg
TRAVELDISTANCE = meters
End Function
Here, the functions actually do not compile due to an error in the line
strUrl = "https://maps.googleapis.com/maps/api/directions/json?origin=" & origin & "&destination=" & destination & "&key=" & apikey
It returns the "Expected: end of statement" error.
I am completely lost and would be so grateful if anyone of you could provide some help.
Best,
Felix
As far as the second approach is concerned, according to this, the URL should look like the following example:
https://maps.googleapis.com/maps/api/directions/json?origin=Disneyland&destination=Universal+Studios+Hollywood&key=YOUR_API_KEY
So in your case, if you have a variable named origin, another one named destination and a third one named apikey, the URL should be built like so:
strUrl ="https://maps.googleapis.com/maps/api/directions/json?origin=" & origin & "&destination=" & destination & "&key=" & apikey
The function would have to be called like so, for example:
call TRAVELDISTANCE("Disneyland", "Universal+Studios+Hollywood", "xxxxx")
I suppose what happened is that in the website where you found the original code, the & character was resolved in its HTML version which is: &. This however will give an error in VBA.
So before copying and pasting something you need to understand how it works.
To combine strings the following applies in general:
finalString= String1 & String2 & "String3" & "String4" & ..... 'depending on whether your strings are stored in variables or not.
I need to get some data from a cloud service.
This is my code so far:
Option Explicit
Sub Test()
Call GetHTTPResult("https://venice.unit4.com/WebConnect/api/ZZKlesserRob/2017/Balance/GetBalance?AccountNumber=604&BeginMonth=1&EndMonth=1", "username", "password")
End Sub
Function GetHTTPResult(sURL As String, Optional username As String, Optional password As String) As String
Dim XMLHTTP As Object, sResult As String
Set XMLHTTP = CreateObject("WinHttp.WinHttpRequest.5.1")
username = "dummy"
password = "dummypass"
XMLHTTP.Open "GET", sURL, False
XMLHTTP.setRequestHeader "Authorization", "Basic" & Base64Encode("username" & ":" & "password")
XMLHTTP.Send
Debug.Print "Status: " & XMLHTTP.Status & " - " & XMLHTTP.StatusText
sResult = XMLHTTP.ResponseText
GetHTTPResult = sResult
Set XMLHTTP = Nothing
End Function
Without the credentials it gives me the "401 - Unauthorized" -response, which is good, I suppose.
However I do have the necessary credentials at my disposal but I can't seem to fix the problem posed by the Base64 encoding.
What should I do?
Thanks in advance!
From inspecting the docs I believe your are missing a space in your Authorization header:
var request = new XMLHttpRequest();
...
request.setRequestHeader("Accept","application/xml");
request.setRequestHeader("Authorization","Basic " + Base64.encode ("User:Password"));
So your should read:
XMLHTTP.setRequestHeader "Authorization", "Basic " & Base64Encode(username & ":" & password)
Also, you should add an Accept header to the request with application/xml or application/json to specify the format of the requested data.
I am trying to access CoinFloor BIST API through Excel VBA or Access VBA. I am able to make get requests (like ticker) successfully. But when I try a post request (like get balance) I get an error "415 Unsupported Media Type". I looked through many threads for this error and all are pointing to the content-type and accept headers, but I was not able to get it working.
The code is pasted below.
Function BalancePostRequest()
Dim auth, URL, data
Dim cred As Credentials
Dim Lib As New jsonlib
cred = getCredentials
auth = cred.userId & "/" & cred.API_Key & ":" & cred.passphrase
URL = "https://webapi.coinfloor.co.uk:8090/bist/XBT/GBP/balance/"
Dim xhr: Set xhr = CreateObject("MSXML2.XMLHTTP")
With xhr
.Open "POST", URL, False
.setRequestHeader "Content-Type", "application/json"
.setRequestHeader "Accept", "application/json"
.setRequestHeader "Authorization", "Basic " + Base64Encode(auth)
End With
xhr.send data
If xhr.Status <> 200 Then
Err.Raise vbObjectError + 1000, "Util.SendRequest", "Status code: " & xhr.Status & " " & xhr.statusText & ". Response was: " & xhr.responseText
End If
Set xhr = Nothing
End Function
I wrote a WinHttp POST request in VBA. It works good as long as there is only one certificate installed on the computer. However, some users have multiple certs with similar certificate names and therefore it returns an error:
a certificate is required to complete client authentication
Any suggestions on how I can select the correct certificate when multiple certificates share similar names? I've tried using both the "friendly name" and the "CN" name of the cert.
Below is my code:
Sub dapull()
Dim URL As String: URL = "https://ce.midwest.org/dart/xml/query"
Dim mfile As String
pulldate = Format(Worksheets("Sheet2").Range("date").Value, "yyyy-mm-dd")
mfile = "<?xml version=" & """" & "1.0" & """" & "?><Envelope xmlns=" & """" & "http://schemas.xmlsoap.org/soap/envelope/" & """" & "><Header/><Body><QueryRequest xmlns=" & """" & "http://markets.midwest.org/dart/xml" & """" & "><QueryResults day=" & """" & pulldate & """" & "><Location>BART</Location></QueryResults></QueryRequest></Body></Envelope>"
Set Req = New WinHttp.WinHttpRequest
With Req
.Open "POST", URL, False
.SetClientCertificate "CURRENT_USER\MY\name" '*this is the issue line
.SetRequestHeader "content-type", "text/xml"
.Send (mfile)
.ResponseText
End With
End Sub
I have the same issue, did you manage to solve it?
VBA just picks the first one :( no way to list or to identify which is which (or at least sort by date or something else before picking up the certificate).
If you did it, please let me know how
For now I "solved" it by asking people to copy their own right certificate into Trusted People section and put into my XLSM an option to switch the store so that it is picked up from CURRENT_USER\TrustedPeople\ instead of MY store.
It works but it is not elegant as it needs the certificate to be manually re-copied every 6 or 12 months (but better than not working at all :) )