Using API on MS Access 2016
I extended the excel sample API V2 app to develop an attendance system for our club. For a number of reasons, we're working to move off of Excel and onto Access. The sample code from WA runs smoothly on Excel, but not on Access. The sample includes the following (in function GetOAuthToken)
Dim httpClient as IXMLHTTPRequest
Set httpClient = CreateObject("Msxml12.XMLHTTP.3.0")
httpClient.Open "POST", url, False
(where url = "https://oauth.wildapricot.org/auth/token")
The client.open returns 'unauthorized'. I cannot find any documentation on the open method of the httpclient object. And I have no idea what extra authorization I need when working in Access. As noted, this code runs with no problem when working in Excel. Both Excel and Access are in Office 2016 on Win 10
Russ Wolfe
shared this idea
-
Open does not actually send something to API, so looks like it is some local security issue.
Please take a look at this forum thread https://social.msdn.microsoft.com/Forums/en-US/1abda1ce-e23c-4d0e-bccd-a323aa7f2ea5/access-is-denied-while-using-microsoftxmlhttp-to-get-a-url-link-in-vbscript-help?forum=xmlandnetfx
-
Russ Wolfe
commented
I have checked to insure that the variable 'url' for the function GetOAuthToken is correctly set to "https://oauth.wildapricot.org/auth/token".
The error is triggered by the httpClient.Open statement
-
Russ Wolfe
commented
Sub SetOAuthCredentials(httpClient As IXMLHTTPRequest)
httpClient.setRequestHeader "User-Agent", "VBA sample app" ' This header is optional, it tells what application is working with API
httpClient.setRequestHeader "Authorization", "Basic " + EncodeBase64("APIKEY:" + ApiKey) ' This header is required, it provides API key for authentication
httpClient.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
End SubFunction GetOAUthToken(ByVal url As String) As String
Debug.Print ("Loading data from " + url)
Dim httpClient As IXMLHTTPRequest
Set httpClient = CreateObject("Msxml2.XMLHTTP.3.0")
httpClient.Open "POST", url, False
SetOAuthCredentials httpClient
httpClient.Send ("grant_type=client_credentials&scope=auto")
If Not httpClient.Status = 200 Then
msg = "Call to " + url + " returned error:" + httpClient.statusText
Err.Raise -1, "GetOAUthToken", msg
End If
Dim resp As String
resp = httpClient.responseText
resp = Mid(resp, Len("{""access_token"":""") + 1, InStr(resp, """,""token_type""") - Len("{""access_token"":""") - 1)GetOAUthToken = resp
End Function
