Jump to content
  • 0

Refresh Token Using VBA



Hi, I still don't have a full solution of using VBA to refresh the token but I have made some progress in that I connect to the server but it returns an error message "Authorization has been denied for this request.". I've checked all of the necessary credentials and they are correct. If there's anyone out there who has knowledge of both VBA and refresh token procedure, I'd be deeply grateful if you could look at the VBA code below to see if there's anything obviously wrong:-

Sub RefreshToken()

Dim hReq As Object, json As Dictionary

Dim sht As Worksheet

Dim strUrl As String

Set sht = Sheet1

strUrl = Cells(1, 5).value 'Variable text held in this cell

Set hReq = CreateObject("MSXML2.XMLHTTP")

    With hReq

        .Open "GET", strUrl, False

        .SetRequestHeader "Authorization", "Basic Base64Encode"

        .SetRequestHeader "Content_Type", "application/x-www-form-urlencoded"

        .SetRequestHeader "grant_type", "refresh_token"

        .SetRequestHeader "refresh_token", “MyRefreshToken”

       .Send 'CreateRefreshRequest()

    End With

Response = hReq.ResponseText

‘//Do other things here

End Sub

Link to comment
Share on other sites

2 answers to this question

Recommended Posts

  • 0

Hi Ron,


I have not tested this very much as I do not work with VBA a lot, but below is sample code you may use and modify for your needs. This is based on posts such as

VBA API Convert JSON response & place into Excel Sheet - Stack Overflow

Function GetToken is self-explanatory, as it gets the access Token using your REST API Token URL. It is using 3rd party open source libraries to parse the JSON response, so you need to add those to Office first. See VBA-tools/VBA-JSON: JSON conversion and parsing for VBA (github.com)

Function SendRequest is very basic and lacks a body for parameters at the moment (you may want to add that), but works. It will try to send a request with the method provided (GET, PUT, etc) and on the URL described. Since we are not providing the auth token when calling it, it will fail once and call GetToken for it. You may want to change this to reduce API call usage/errors.


Global AuthToken As String
Public limiter As Integer

Public Function GetToken() As String
Dim objrequest As MSXML2.XMLHTTP60
Dim strUrl As String
Dim blnAsync As Boolean
Dim strResponse As String
Dim clientID As String
Dim clientSecret As String
Dim authbody As String
Dim TokenJson As Dictionary
Dim JsonValues As Variant

Set objrequest = New MSXML2.XMLHTTP60
strUrl = "https://********.caspio.com/oauth/token"
clientID = "&client_id=yourclientid"
clientSecret = "&client_secret=yourclientsecret"
authbody = "grant_type=client_credentials" & clientID & clientSecret
blnAsync = False

With objrequest
    .Open "POST", strUrl, False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    '.setRequestHeader "Authorization", "Basic " & TextBase64Encode(bas, "us-ascii")
    '.setRequestHeader "Access-Control-Allow-Methods", "POST"
    .send authbody
    'spin wheels whilst waiting for response
    While objrequest.ReadyState <> 4
'While request is completed, do something
    If objrequest.ReadyState = 4 Then
    If objrequest.Status = 200 Then
        strResponse = .responseText
    ElseIf objrequest.Status = 401 Then
        strResponse = "Unauthorized API"
    End If
    strResponse = .responseText
    Set TokenJson = JsonConverter.ParseJson(strResponse)
    End If
End With
AuthToken = TokenJson("access_token")
Debug.Print AuthToken

End Function

Public Function SendRequest(Op As String, strUrl As String) As String
Dim objrequest1 As MSXML2.XMLHTTP60
Dim blnAsync As Boolean
Dim strResponse As String
Dim AuthStr As String
Dim retry As String

Set objrequest1 = New MSXML2.XMLHTTP60
blnAsync = False
AuthStr = "Bearer " & AuthToken
Debug.Print "TokenCheck"
Debug.Print AuthToken
Debug.Print AuthStr

With objrequest1
    .Open Op, strUrl, False
    .setRequestHeader "Authorization", "Bearer " & AuthToken
    'send "q=where..."
    'spin wheels whilst waiting for response
    While objrequest1.ReadyState <> 4
'While request is completed, do something
    If objrequest1.ReadyState = 4 Then
        If objrequest1.Status = 200 Then
            strResponse = .responseText
		'If response is 401 (unauthorized), call GetToken, retry up to 5 times to avoid rate limit errors or excessive calls
        ElseIf objrequest1.Status = 401 And limiter <= 5 Then
        Debug.Print "401...Getting Token"
            retry = GetToken()
            limiter = limiter + 1
            GoTo Start
        End If
    strResponse = .responseText
    End If
End With

Debug.Print strResponse

End Function

Sub CallAPI()
Dim tryAPI As String
tryAPI = SendRequest("GET", "https://********.caspio.com/rest/v2/tables/yourtable/records")
End Sub




Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • Create New...