OAuth2.0 and Excel

6007 views
Skip to first unread message

Kyle Beachill

unread,
Jul 9, 2013, 1:44:59 PM7/9/13
to excel-r...@googlegroups.com
Hi Bruce,

I was just about to start work helping someone on another forum that requires OAuth2.0 for Google integration, I haven't seen an Excel client for it - but before I got cracking on it; it occurred to me that this is the kind of thing that you may have done already ;) If so, could you point me towards it on your site (I couldn't find anything with a search), if not would you mind sharing some of your musings/plan of attack?

Excel isn't a particularly easy client, but my thoughts/ramblings are that I'm going to either need an integrated webbrowser or to automate IE - from an experience point of view I quite like an integrated browser, but to keep things lightweight I'll probably go for IE automation, then it's just a case of caching the refresh tokens and checking expiry before firing off requests.


Thanks 

Kyle



Bruce Mcpherson

unread,
Jul 9, 2013, 1:58:39 PM7/9/13
to excel-r...@googlegroups.com
Hi Kyle 

yes oauth from Excel is nuisance. I was going to implement it at one point, but got a headache. Instead I do this - essentially passing off the work to Google Apps Script, where things are a bit easier.

it's not ideal, and it is something I need to get back to at some point. So far the only authentication ive done in excel is basic authentication

Next up on my list was digest authentication, which i've recently done on Google Apps Script

I'd be interested to see what you come up with

bruce




Kyle



--
You received this message because you are subscribed to the Google Groups "Excel Liberation" group.
To unsubscribe from this group and stop receiving emails from it, send an email to excel-ramblin...@googlegroups.com.
For more options, visit https://groups.google.com/groups/opt_out.
 
 

Kyle Beachill

unread,
Jul 9, 2013, 2:25:43 PM7/9/13
to excel-r...@googlegroups.com
Thanks Bruce,


I'll have a go at the whole thing, see how far I get and let you know

Cheers

Bruce Mcpherson

unread,
Jul 9, 2013, 3:13:53 PM7/9/13
to excel-r...@googlegroups.com
Actually I hadnt seen that - I've just checked in with the guy who does it.. see what his experiences are

thanks for the link

bruce


On 9 July 2013 19:25, Kyle Beachill <kyle.b...@googlemail.com> wrote:

Kyle Beachill

unread,
Jul 10, 2013, 10:56:16 AM7/10/13
to excel-r...@googlegroups.com
I've made a first draft of a drop in for that project, it's an additional OAuth Class for Google which works to the same interface. It needs some scrubbing up, but it's functional at least and returns valid tokens - it caches them, but I haven't gotten round to the expiry part yet.

Implements IAuthenticator


Option Explicit


' --------------------------------------------- '
' Properties
'
--------------------------------------------- '


Public ClientId As String
Public ClientSecret As String
Public Username As String
Public Password As String
Public TokenUrl As String
Public TokenKey As String
Public Token As String
Public AuthUrl As String
Public AuthCode As String
Public CacheToken As Boolean


Private ieComplete As Boolean


Private WithEvents oIExplorer As InternetExplorer


'
============================================= '
'
Public Methods
' ============================================= '


''
' Helper for setting required parameters at once
'

' @param {String} ClientId
'
@param {String} ClientSecret
' --------------------------------------------- '


Public Sub Setup(ClientId As String, ClientSecret As String)
   
Me.ClientId = ClientId
   
Me.ClientSecret = ClientSecret
End Sub


''
' Setup token url that is used to request token
'

' @param (String) AuthUrl
'
@param {String} TokenUrl
' @param {String} [TokenKey="access_token"] The key used to retrieve the token from the response
'
--------------------------------------------- '


Public Sub SetupTokenUrl(AuthUrl As String, TokenUrl As String, Optional TokenKey As String = "access_token")
    Me.TokenUrl = TokenUrl
    Me.TokenKey = TokenKey
    Me.AuthUrl = AuthUrl
End Sub


Private Sub IAuthenticator_BeforeExecute(Request As RestRequest)
    On Error GoTo ErrorHandling
    If (Me.Token = "" Or Not Me.CacheToken) And (Me.TokenUrl <> "" And Me.TokenKey <> "") Then
       
        Set oIExplorer = New InternetExplorer
        With oIExplorer
            .Navigate CreateAuthRequest()
            .AddressBar = False
            .MenuBar = False
            .Resizable = False
            .Visible = True
        End With
       
        '
Wait for userInteraction
       
Do: DoEvents: Loop Until ieComplete
       
       
'Do we have an Authentication Code?
        If Len(Me.AuthCode) = 0 Then
            Err.Raise vbObjectError + 2, _
                Description:="User cancelled Authentication"
        End If
       
        '
Now Get a new Token
       
Dim http As MSXML2.ServerXMLHTTP
       
Set http = New MSXML2.ServerXMLHTTP


       
Call http.Open("POST", Me.TokenUrl, False)
        http
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
       
Call http.send(CreateTokenRequest())


       
If http.Status <> 200 Then
           
' Error getting OAuth2 token
            Err.Raise vbObjectError + http.Status, _
                Description:="Failed to retrieve OAuth2 Token - " & http.Status & ": " & http.responseText
        End If
       
        Dim Response As Dictionary
        Set Response = RestHelpers.ParseJSON(http.responseText)
        If Not Response Is Nothing Then
            If Response.Exists(Me.TokenKey) Then
                Me.Token = Response(Me.TokenKey)
            End If
           
            '
(Salesforce specific, but shouldn't affect any other OAuth2 clients)
            If Response.Exists("instance_url") Then
                Request.BaseUrl = Response("instance_url")
            End If
        Else
            Err.Raise vbObjectError + 2, _
                Description:="Failed to read OAuth2 Token"
        End If
    End If
    Call Request.AddHeader("Authorization", CreateHeader())
   
ErrorHandling:
   
    If Not http Is Nothing Then Set http = Nothing
    If Not Response Is Nothing Then Set Response = Nothing
   
    If Err.Number <> 0 Then
        '
Rethrow error
       
Err.Raise Err.Number, Description:=Err.Description
   
End If
End Sub


Private Sub IAuthenticator_HttpOpen(http As MSXML2.IXMLHTTPRequest, Request As RestRequest, BaseUrl As String, Optional useAsync As Boolean = False)
   
' Perform standard http open
    Call http.Open(Request.MethodName(), Request.FullUrl(BaseUrl), useAsync)
End Sub


'
============================================= '
'
Private Methods
' ============================================= '


Private Function CreateHeader() As String
   
' Create standard OAuth2 header
    CreateHeader = "Bearer " & Me.Token
End Function
Private Function CreateAuthRequest() As String
    '
Generate initial Authentication Request
   
' Using installed application flow: https://developers.google.com/accounts/docs/OAuth2InstalledApp
    CreateAuthRequest = Me.AuthUrl
    If InStr(1, CreateAuthRequest, "?") < 1 Then: CreateAuthRequest = CreateAuthRequest & "?"
    CreateAuthRequest = CreateAuthRequest & "response_type=code"
    CreateAuthRequest = CreateAuthRequest & "&client_id=" & Me.ClientId
    CreateAuthRequest = CreateAuthRequest & "&&redirect_uri=urn:ietf:wg:oauth:2.0:oob"
    CreateAuthRequest = CreateAuthRequest & "&scope=openid"
End Function




Private Function CreateTokenRequest() As String


    CreateTokenRequest = "code=" & Me.AuthCode
    CreateTokenRequest = CreateTokenRequest & "&client_id=" & Me.ClientId
    CreateTokenRequest = CreateTokenRequest & "&client_secret=" & Me.ClientSecret
    CreateTokenRequest = CreateTokenRequest & "&redirect_uri=urn:ietf:wg:oauth:2.0:oob" '
More Likely than not to be static
   
CreateTokenRequest = CreateTokenRequest & "&grant_type=authorization_code" 'More Likely than not to be static


End Function
'
Break Loop on user Quit of IE
Private Sub oIExplorer_OnQuit()
    ieComplete
= True
End Sub


Private Sub oIExplorer_TitleChange(ByVal Text As String)
   
If InStr(1, Text, "Success") > 0 Then
       
Me.AuthCode = oIExplorer.Document.getElementbyid("code").Value
        oIExplorer
.Quit
   
ElseIf InStr(1, Text, "Denied") > 0 Then
        oIExplorer
.Quit
   
End If
End Sub



Bruce Mcpherson

unread,
Jul 10, 2013, 11:03:47 AM7/10/13
to excel-r...@googlegroups.com
looks good .. you're building on the stuff from tim hall's site ?


Kyle Beachill

unread,
Jul 10, 2013, 11:09:24 AM7/10/13
to excel-r...@googlegroups.com
Yes, but only because the guy I'm helping is already using his code, I like the idea of the toolset he is putting together, tbh I find his coding style hard work - too many public variables hanging around for my liking and I like my variables to be descriptive with hungariany overtones ;)

Kyle Beachill

unread,
Jul 15, 2013, 1:10:01 PM7/15/13
to excel-r...@googlegroups.com
Hi Bruce, 

Here's a standalone, working class that authenticates on OAuth2 for google - tested with Analytics API. Refresh Key, timeout and Token are persisted in the registry - this isn't ideal from a security point of view, but I'll leave that to others to resolve or live with ;) :

Option Explicit

Private Enum AuthenticationStatus
    NotAuthenticated = 1
    TokenExpired = 2
    Authenticated = 3
End Enum


Private strClientId As String
Private strClientSecret As String

Private strTokenKey As String
Private strToken As String
Private strRefreshToken As String

Private strAuthUrl As String
Private strTokenUrl As String
Private strAuthCode As String

Private dtExpiresWhen As Date

Private blnCacheToken As Boolean
Private blnIeComplete As Boolean

Private oScriptControl As Object
Private strResponseText As String
Private oResponse As Object

Private strRedirectUri As String
Private Const CONST_STR_GRANT_TYPE As String = "grant_type=authorization_code"
Private Const CONST_STR_AUTH_RESPONSE_TYPE As String = "response_type=code"

Private WithEvents oIExplorer As InternetExplorer


Private Sub Class_Initialize()
    'Import the refreshy stuff
    strToken = GetSetting("GoogleAuth", "Tokens", "Token")
    strRefreshToken = GetSetting("GoogleAuth", "Tokens", "RefreshKey")
    Dim sDate As String
    sDate = GetSetting("GoogleAuth", "Tokens", "TokenExpiry")
    If Len(sDate) > 0 Then
         dtExpiresWhen = CDate(sDate)
     Else
         dtExpiresWhen = #1/1/1900#
     End If
End Sub
Public Sub InitEndPoints( _
    Optional ByVal AuthUrl As String = "https://accounts.google.com/o/oauth2/auth", _
    Optional ByVal TokenUrl As String = "https://accounts.google.com/o/oauth2/token", _
    Optional ByVal RedirectUri As String = "urn:ietf:wg:oauth:2.0:oob" _
)
    
    strAuthUrl = AuthUrl
    strTokenUrl = TokenUrl
    strRedirectUri = RedirectUri
    
End Sub
Public Sub InitClientCredentials(ByVal ClientId As String, ByVal ClientSecret As String)

    strClientId = ClientId
    strClientSecret = ClientSecret

End Sub
Private Function getAuthenticationStatus() As AuthenticationStatus
    
    If Len(strRefreshToken) = 0 Then
        getAuthenticationStatus = NotAuthenticated
        Exit Function
    End If
    
    If dtExpiresWhen < DateAdd("s", 10, Now()) Then
        getAuthenticationStatus = TokenExpired
        Exit Function
    End If
    
    getAuthenticationStatus = Authenticated
    
    
End Function
Private Sub GetNewToken()
    
    Dim http As MSXML2.ServerXMLHTTP
   ' If (strToken = "" Or Not blnCacheToken) And (strTokenUrl <> "" And strTokenKey <> "") Then
        
        Set oIExplorer = New InternetExplorer
        With oIExplorer
            .Navigate CreateAuthRequest()
            .AddressBar = False
            .MenuBar = False
            .Resizable = False
            .Visible = True
        End With
        
        'Wait for userInteraction
        Do: DoEvents: Loop Until blnIeComplete
        
        'Do we have an Authentication Code?
        If Len(strAuthCode) = 0 Then
            Err.Raise vbObjectError + 2, _
                Description:="User cancelled Authentication"
        End If
        
        'Now Get a new Token
        Set http = New MSXML2.ServerXMLHTTP


        Call http.Open("POST", strTokenUrl, False)
        http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        Call http.send(CreateTokenRequest())

        If http.Status <> 200 Then
            ' Error getting OAuth2 token
            Err.Raise vbObjectError + http.Status, _
                Description:="Failed to retrieve OAuth2 Token - " & http.Status & ": " & http.responseText
        End If
        
        strToken = GetProp("access_token", http.responseText)
        strRefreshToken = GetProp("refresh_token")
        dtExpiresWhen = DateAdd("s", CLng(GetProp("expires_in")), Now())
        
        
        'Persist the Refresh key and expiry - the above should only ever need running once per application
        SaveSetting "GoogleAuth", "Tokens", "RefreshKey", strRefreshToken
        SaveSetting "GoogleAuth", "Tokens", "Token", strToken
        SaveSetting "GoogleAuth", "Tokens", "TokenExpiry", CStr(dtExpiresWhen)
        
   ' End If
End Sub

Private Sub RefreshToken()

        Dim http As MSXML2.ServerXMLHTTP
        Set http = New MSXML2.ServerXMLHTTP


        Call http.Open("POST", strTokenUrl, False)
        http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        Call http.send(CreateRefreshRequest())
        

        If http.Status <> 200 Then
            ' Error getting OAuth2 token
            Err.Raise vbObjectError + http.Status, _
                Description:="Failed to retrieve OAuth2 Token - " & http.Status & ": " & http.responseText
        End If
        
        strToken = GetProp("access_token", http.responseText)
        dtExpiresWhen = DateAdd("s", CLng(GetProp("expires_in")), Now())
        
        SaveSetting "GoogleAuth", "Tokens", "Tokens", strToken
        SaveSetting "GoogleAuth", "Tokens", "TokenExpiry", CStr(dtExpiresWhen)
        
        
End Sub

Private Function CreateAuthRequest() As String
    ' Generate initial Authentication Request
    ' Using installed application flow: https://developers.google.com/accounts/docs/OAuth2InstalledApp
    CreateAuthRequest = strAuthUrl
    If InStr(1, CreateAuthRequest, "?") < 1 Then: CreateAuthRequest = CreateAuthRequest & "?"
    CreateAuthRequest = CreateAuthRequest & CONST_STR_AUTH_RESPONSE_TYPE
    CreateAuthRequest = CreateAuthRequest & "&client_id=" & strClientId
    CreateAuthRequest = CreateAuthRequest & "&redirect_uri=" & strRedirectUri
    CreateAuthRequest = CreateAuthRequest & "&scope=https%3A%2F%2Fwww.googleapis.com%2Fauth%2Fanalytics.readonly"
End Function

Private Function CreateTokenRequest() As String

    CreateTokenRequest = "code=" & strAuthCode
    CreateTokenRequest = CreateTokenRequest & "&client_id=" & strClientId
    CreateTokenRequest = CreateTokenRequest & "&client_secret=" & strClientSecret
    CreateTokenRequest = CreateTokenRequest & "&redirect_uri=urn:ietf:wg:oauth:2.0:oob" 'More Likely than not to be static
    CreateTokenRequest = CreateTokenRequest & "&" & CONST_STR_GRANT_TYPE 'More Likely than not to be static

End Function

Private Function CreateRefreshRequest() As String

    CreateRefreshRequest = "client_id=" & strClientId
    CreateRefreshRequest = CreateRefreshRequest & "&client_secret=" & strClientSecret
    CreateRefreshRequest = CreateRefreshRequest & "&refresh_token=" & strRefreshToken
    CreateRefreshRequest = CreateRefreshRequest & "&grant_type=refresh_token"
    
End Function

Private Function GetProp(strPropName As String, Optional strJSObject As String = "") As String
    
    If oScriptControl Is Nothing Then Set oScriptControl = CreateObject("ScriptControl")
    
    With oScriptControl
        .Language = "JScript"
        .AddCode "function getProp(json, prop) { return json[prop]; }"
        
        If Len(strJSObject) > 0 Then
            strResponseText = strJSObject
            Set oResponse = .eval("(" & strJSObject & ")")
        End If
        GetProp = .Run("getProp", oResponse, strPropName)
    End With
    

End Function
'IE handling
'Break Loop on user Quit of IE
Private Sub oIExplorer_OnQuit()
    blnIeComplete = True
End Sub

'Check the title Window, if Success or Denied Found End the IE interaction
Private Sub oIExplorer_TitleChange(ByVal Text As String)
    If InStr(1, Text, "Success") > 0 Then
        strAuthCode = oIExplorer.Document.getElementbyid("code").value
        oIExplorer.Quit
    ElseIf InStr(1, Text, "Denied") > 0 Then
        oIExplorer.Quit
    End If
End Sub

Public Function Query(strQuery As String) As String
    
    Dim eAuthStatus As AuthenticationStatus
    Dim Request As MSXML2.ServerXMLHTTP
    
    eAuthStatus = getAuthenticationStatus
    
    If eAuthStatus = NotAuthenticated Then
        GetNewToken
    ElseIf eAuthStatus = TokenExpired Then
        RefreshToken
    End If
    
    Set Request = New MSXML2.ServerXMLHTTP
    
    With Request
        .Open "GET", strQuery, False
        .setRequestHeader "Authorization", "Bearer " & strToken
        .send
        Query = .responseText
    End With
    
End Function


Tested with:
Sub test()
Dim o As OAuth2GoogleAuthenticator
Set o = New OAuth2GoogleAuthenticator
o.InitClientCredentials "ID", "Secret"
o.InitEndPoints

End Sub


This follows the installed application flow, so all the OAuth stuff will need setting in the Google API panel. The access scope is currently set to Google Analytics data (as that's what I was helping on) and provides an obvious place for expansion.

It's a bit rough and ready, and could do with a bit of cleaning up, but it works and I hope someone finds it useful :)

Cheers

Kyle

Bruce Mcpherson

unread,
Jul 15, 2013, 1:16:37 PM7/15/13
to excel-r...@googlegroups.com
excellent.. i'll play with this over the next few days
thanks Kyle


Bruce Mcpherson

unread,
Jul 16, 2013, 4:59:32 AM7/16/13
to excel-r...@googlegroups.com
Kyle

any objections if I copy this post into a guest page on http://ramblings.mcpher.com/Home/excelquirks/guests

bruce

Kyle Beachill

unread,
Jul 16, 2013, 5:25:45 AM7/16/13
to excel-r...@googlegroups.com
Morning Bruce,

None at all, would you like me to tidy it up a bit first?

Bruce Mcpherson

unread,
Jul 16, 2013, 5:29:56 AM7/16/13
to excel-r...@googlegroups.com
Sure 

even better!

bruce

Kyle Beachill

unread,
Jul 16, 2013, 9:36:59 AM7/16/13
to excel-r...@googlegroups.com
Hi Bruce,

How's this?
' ================================================================================== '
'
' OAuth 2.0 Google Authenticator
' Developed by Kyle Beachill
'
' Inspired loosely by Tim Halls authentication classes in his Excel-Rest library:
'
'
' Features:
'     Simple class to handle Google OAuth 2.0 Authentication
'     Follows the Installed Application Flow
'     Returns Simply the value for the Authorization header in API requests
'
' Gotchas:
'     Tokens are held in plain text in the registry
'
' Required References:
'   - Microsoft Internet Controls
'   - Microsoft XML
'
' ================================================================================== '


Option Explicit

'// Simple enum for current authentication status
Private Enum AuthenticationStatus
    NotAuthenticated = 1
    TokenExpired = 2
    Authenticated = 3
End Enum


'// Application Client ID and Application Secret
Private strClientId As String
Private strClientSecret As String

'// Authentication codes, tokens and expiry date
Private strTokenKey As String
Private strToken As String
Private strRefreshToken As String
Private dtExpiresWhen As Date
Private strAuthCode As String

'// Url End points for the authentication
Private strAuthUrl As String
Private strTokenUrl As String
Private strRedirectUri As String

'// Internet Explorer variables for initial authentication request
Private WithEvents oIExplorer As InternetExplorer
Private blnIeComplete As Boolean

Private strResponseText As String
Private oResponse As Object

'// Save the request object to prevent being created for each token expiry
Private objXMLRequest As MSXML2.ServerXMLHTTP



'// Since we are persisting the credentials to the registry, we need to read these in each time the class
'// is initialized, if they aren't found - these will be default values, "" for strings and 1900/01/01 for te date
Private Sub Class_Initialize()
    
    Dim sDate As String

    strToken = GetSetting("GoogleAuth", "Tokens", "Token")
    strRefreshToken = GetSetting("GoogleAuth", "Tokens", "RefreshKey")
    sDate = GetSetting("GoogleAuth", "Tokens", "TokenExpiry")
    
    If Len(sDate) > 0 Then
         dtExpiresWhen = CDate(sDate)
    Else
         dtExpiresWhen = #1/1/1900#
    End If
    
End Sub

'// Allows the overriding of the default google EndPoints - these are unlikely to change
Public Sub InitEndPoints( _
    Optional ByVal AuthUrl As String = "https://accounts.google.com/o/oauth2/auth", _
    Optional ByVal TokenUrl As String = "https://accounts.google.com/o/oauth2/token", _
    Optional ByVal RedirectUri As String = "urn:ietf:wg:oauth:2.0:oob" _
)
    
    strAuthUrl = AuthUrl
    strTokenUrl = TokenUrl
    strRedirectUri = RedirectUri
    
End Sub

'// Application ID and Secret will always need passing, since they are required for refresh calls
'// Though these *could* be persisted in the registry also
Public Sub InitClientCredentials(ByVal ClientId As String, ByVal ClientSecret As String)

    strClientId = ClientId
    strClientSecret = ClientSecret

End Sub

'// Simple function to return the authentication status of the currently held credentials

Private Function getAuthenticationStatus() As AuthenticationStatus
        
    '// If the Refresh Token Length is 0 then the initial authentication hasn't occurred
    If Len(strRefreshToken) = 0 Then
        getAuthenticationStatus = NotAuthenticated
        Exit Function
    End If
    
    '// If the refresh date is less than now (with a 10 second buffer) then the token has expired
    If dtExpiresWhen < DateAdd("s", 10, Now()) Then
        getAuthenticationStatus = TokenExpired
        Exit Function
    End If
    
    '// Otherwise the token is valid
    getAuthenticationStatus = Authenticated
    
    
End Function
Private Sub GetNewToken()
    

    Set oIExplorer = New InternetExplorer
    
    With oIExplorer
        .Navigate CreateAuthRequest()
        .AddressBar = False
        .MenuBar = False
        .Resizable = False
        .Visible = True
    End With
    
    '// Wait for userInteraction
    Do: DoEvents: Loop Until blnIeComplete
    
    '// Do we have an Authentication Code?
    If Len(strAuthCode) = 0 Then
        Err.Raise vbObjectError + 2, _
            Description:="User cancelled Authentication"
    End If
    
    '// Now Get a new Token
    If objXMLRequest Is Nothing Then Set objXMLRequest = New MSXML2.ServerXMLHTTP
    
    With objXMLRequest
        .Open "POST", strTokenUrl, False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send CreateTokenRequest()

        If .Status <> 200 Then
            '// Error getting OAuth2 token
            Err.Raise vbObjectError + http.Status, _
                Description:="Failed to retrieve OAuth2 Token - " & http.Status & ": " & http.responseText
        End If
        
        '// Get the credentials from the response
        strToken = GetProp("access_token", .responseText)
        strRefreshToken = GetProp("refresh_token")
        dtExpiresWhen = DateAdd("s", CLng(GetProp("expires_in")), Now())
    
    End With
    
    '// Persist the Refresh key and expiry - the above should only ever need running once per application
    SaveSetting "GoogleAuth", "Tokens", "RefreshKey", strRefreshToken
    SaveSetting "GoogleAuth", "Tokens", "Token", strToken
    SaveSetting "GoogleAuth", "Tokens", "TokenExpiry", CStr(dtExpiresWhen)

End Sub

Private Sub RefreshToken()

    If objXMLRequest Is Nothing Then Set objXMLRequest = New MSXML2.ServerXMLHTTP
    
    With objXMLRequest
        .Open "POST", strTokenUrl, False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send CreateRefreshRequest()
        If .Status <> 200 Then
            '// Error getting OAuth2 token
            Err.Raise vbObjectError + http.Status, _
                Description:="Failed to retrieve OAuth2 Token - " & http.Status & ": " & http.responseText
        End If
        
        '// Get the credentials from the response
        strToken = GetProp("access_token", .responseText)
        dtExpiresWhen = DateAdd("s", CLng(GetProp("expires_in")), Now())
    End With
    
    '// Persist new token in registry
    SaveSetting "GoogleAuth", "Tokens", "Token", strToken
    SaveSetting "GoogleAuth", "Tokens", "TokenExpiry", CStr(dtExpiresWhen)
        
        
End Sub
'// Simple function that gets a propery from a single depth JSON formatted string
'// Requires the property name
'// Requires te JSON string on the first pass
Private Function GetProp(strPropName As String, Optional strJSObject As String = "") As String
    
    Static oScriptControl As Object
    
    If oScriptControl Is Nothing Then Set oScriptControl = CreateObject("ScriptControl")
    
    With oScriptControl
        .Language = "JScript"
        .AddCode "function getProp(json, prop) { return json[prop]; }"
        
        If Len(strJSObject) > 0 Then
            strResponseText = strJSObject
            Set oResponse = .eval("(" & strJSObject & ")")
        End If
        GetProp = .Run("getProp", oResponse, strPropName)
    End With

End Function
'// Public property to return the Authorisation value header for a request
Public Property Get AuthHeader() As String
    
    Dim eAuthStatus As AuthenticationStatus
    
    eAuthStatus = getAuthenticationStatus
    
    If eAuthStatus = NotAuthenticated Then
        GetNewToken
    ElseIf eAuthStatus = TokenExpired Then
        RefreshToken
    End If
    
    AuthHeader = "Bearer " & strToken
    
    
End Property

'//===========================================================================================================
'// String building functions for the requests

'// Step 1: The initial url for authentication - Note the scope attribute, this sets what the application can access
Private Function CreateAuthRequest() As String
    ' Generate initial Authentication Request
    ' Using installed application flow: https://developers.google.com/accounts/docs/OAuth2InstalledApp
    CreateAuthRequest = strAuthUrl
    If InStr(1, CreateAuthRequest, "?") < 1 Then: CreateAuthRequest = CreateAuthRequest & "?"
    CreateAuthRequest = CreateAuthRequest & "response_type=code"
    CreateAuthRequest = CreateAuthRequest & "&client_id=" & strClientId
    CreateAuthRequest = CreateAuthRequest & "&redirect_uri=" & strRedirectUri
    CreateAuthRequest = CreateAuthRequest & "&scope=https%3A%2F%2Fwww.googleapis.com%2Fauth%2Fanalytics.readonly"
End Function

'// Step 2: The initial POST body to get the initial Token and refresh token
Private Function CreateTokenRequest() As String

    CreateTokenRequest = "code=" & strAuthCode
    CreateTokenRequest = CreateTokenRequest & "&client_id=" & strClientId
    CreateTokenRequest = CreateTokenRequest & "&client_secret=" & strClientSecret
    CreateTokenRequest = CreateTokenRequest & "&redirect_uri=" & strRedirectUri
    CreateTokenRequest = CreateTokenRequest & "&grant_type=authorization_code"

End Function

'// Step 3: The POST body to refresh a token after it has expired
Private Function CreateRefreshRequest() As String

    CreateRefreshRequest = "client_id=" & strClientId
    CreateRefreshRequest = CreateRefreshRequest & "&client_secret=" & strClientSecret
    CreateRefreshRequest = CreateRefreshRequest & "&refresh_token=" & strRefreshToken
    CreateRefreshRequest = CreateRefreshRequest & "&grant_type=refresh_token"
    
End Function

'//===========================================================================================================
'// Event handling for Internet Explorer Object
'// OAuth 2.0 Process flow requires a user to provide access through the browser for initial Authentication

'//Break Loop on user Quit of IE
Private Sub oIExplorer_OnQuit()
    blnIeComplete = True
End Sub

'//Check the title Window, if Success or Denied Found End the IE interaction
Private Sub oIExplorer_TitleChange(ByVal Text As String)

    If InStr(1, Text, "Success") > 0 Then
        strAuthCode = oIExplorer.Document.getElementbyid("code").Value
        oIExplorer.Quit
    ElseIf InStr(1, Text, "Denied") > 0 Then
        oIExplorer.Quit
    End If

End Sub

Bruce Mcpherson

unread,
Jul 16, 2013, 9:58:51 AM7/16/13
to excel-r...@googlegroups.com
yep - do you want to write an introduction paragraph, you have a blog.website to promote etc..?

Bruce Mcpherson

unread,
Jul 30, 2013, 1:04:06 PM7/30/13
to excel-r...@googlegroups.com
Hi Kyle

published your article


bruce

Kyle Beachill

unread,
Jul 30, 2013, 1:53:26 PM7/30/13
to excel-r...@googlegroups.com
Hi Bruce, thanks :) I missed your earlier message.

I've noticed a typo if you wouldn't mind fixing it for me please, in both the XML calls, in the error catch, there's a reference to http. Could you remove this please an just leave the . As part of the with. Block

Thanks

Kyle

Sent from my iPad

gaspar...@gmail.com

unread,
Jul 31, 2013, 4:15:49 AM7/31/13
to excel-r...@googlegroups.com
Hi Kyle!
 
I'm struggling on this one: OAuth2GoogleAuthenticator. I'm not familiar with Google Auth, and it is maybe trivial. But what is it?

 

Thanks a lot !!
 
Gaspard

Bruce Mcpherson

unread,
Jul 31, 2013, 4:59:34 AM7/31/13
to excel-r...@googlegroups.com
ok - done.

thanks again
bruce

Kyle Beachill

unread,
Jul 31, 2013, 5:31:01 AM7/31/13
to excel-r...@googlegroups.com
Hi Gaspard,

Certain Google APIs and Services require you to use a higher level (called OAuth 2.0) of security than just an API key; the Google Analytics API for example. The posted class that Bruce has also kindly put on automates this type of authentication which can be a bit complicated and bewildering if you aren't used to developing for the web.

It may be that you don't actually need it at all depending on the services you are using, they should specify in the documentation how you need to authenticate.

Thanks

Kyle

Bruce Mcpherson

unread,
Oct 11, 2013, 12:34:29 PM10/11/13
to excel-r...@googlegroups.com
Hi Kyle,

Developed this out  a little.


Bruce

Kyle Beachill

unread,
Oct 21, 2013, 12:34:53 PM10/21/13
to excel-r...@googlegroups.com
Hi Bruce,

Sorry it's taken me a long time to respond, really busy at work!

That's really nice, far more polished than my initial stab :) the encryption in the registry is a nice touch - I'd looked briefly at DPAPI, but was looked too painful considering the added benefit - the CAPICOM implementation is much more straightforward. Whilst good practice, encryption always seems a bit pointless in VBA considering its inherent insecurity.

On a more conceptual basis, I noticed the below function:
Public Function addGoogleScope(s As String) As cOauth2
   


   
With pPackage.child("parameters")
       
Select Case s
           
Case "analytics"
               
.add "scope", URLEncode("https://www.googleapis.com/auth/analytics.readonly")
           
           
Case "drive"
               
.add "scope", URLEncode("https://www.googleapis.com/auth/drive")
               
           
Case "feeds"
               
.add "scope", URLEncode("https://spreadsheets.google.com/feeds")
               
           
Case "viz"
               
.add "scope", URLEncode("https://spreadsheets.google.com/feeds") + "+" & _
                     
URLEncode("https://www.googleapis.com/auth/drive")
           
           
Case "urlshortener"
               
.add "scope", URLEncode("https://www.googleapis.com/auth/urlshortener")
               
               
           
Case default
               
Debug.Assert False
       
End Select
   
End With
   
Set addGoogleScope = Me
End Function

Takes a string as a parameter, in these types of scenarios, I'd usually go for an enum as it would provide intellisense and stop me making typos. Though when helping on forums I go with a string as you have above since fewer people tend to be familiar with enumerations and a string parameter is easier for users with lower ability to edit and understand. Having quite strong patterns and approaches in your code I suspect that it was a concious design decision to go with the string parameter - and since your code isn't really beginner friendly ;) I was curious why you chose this approach - not that I'm saying I disagree with it, more that I'm interested to hear your opinion on passing a string as a param vs using an enum.

Cheers

Kyle

Bruce Mcpherson

unread,
Oct 21, 2013, 1:01:09 PM10/21/13
to excel-ramblings@googlegroups com

Hi kyle

I usually usestrings for something that might be user extended on their own version. Avoids having multiple versions of a global enum. If its something that is unlikely to need extending then I'd use an enum.

On the encryption, i still haven't figured the 64 bit version.

Bru e

Pieter

unread,
Nov 10, 2017, 4:41:23 AM11/10/17
to Excel Liberation
Hi

Great to see all of your posts.

I'm really strugling  with something that looks a little bit like this. 

I've build a web api and I registered it with Azure AD. Now I want to use the api in Excel VBA but I have no idea how to authenticate.
Any ideas?


Bruce Mcpherson

unread,
Nov 10, 2017, 4:48:43 AM11/10/17
to excel-r...@googlegroups.com
Hi Pieter

I don't use Azure at all so I don't know anything at all about - however it looks just like a regular oauth2 flow, similar to the one I've published for getting to google APIS from VBA. I think it could be easily tweaked to handle azure.. have you looked at that?




--
You received this message because you are subscribed to the Google Groups "Excel Liberation" group.
To unsubscribe from this group and stop receiving emails from it, send an email to excel-ramblings+unsubscribe@googlegroups.com.
For more options, visit https://groups.google.com/d/optout.

obeir...@gmail.com

unread,
Aug 15, 2018, 11:45:16 AM8/15/18
to Excel Liberation
Hello Bruce, and thanks to Kyle for the contribution.
I've tried the example on a UK site that use oAuth2 and am not getting far.
For AuthUrl I have

I have the client id and client secret, but when the code gets to
    With oIExplorer
        .Navigate CreateAuthRequest()

Explorer quits at once (oIExplorer_OnQuit() is called and so blnIeComplete = True)
and get the error raised "User cancelled Authorization"

and I am left with a Downloads manager prompt "Do you want to Save the file " and clicking Save does nothing.
Running again gets an immediate failure at the New InternetExplorer line with "The interface is unknown"

Windows 10, IE 11.165.17134.0

obeir...@gmail.com

unread,
Aug 23, 2018, 4:32:47 AM8/23/18
to Excel Liberation
OK found it .. I needed to register the redirect URI "urn:ietf:wg:oauth:2.0:oob" at their website.

Bruce Mcpherson

unread,
Aug 23, 2018, 5:49:52 AM8/23/18
to excel-r...@googlegroups.com

--
You received this message because you are subscribed to the Google Groups "Excel Liberation" group.
To unsubscribe from this group and stop receiving emails from it, send an email to excel-ramblin...@googlegroups.com.

obeir...@gmail.com

unread,
Aug 23, 2018, 6:18:35 AM8/23/18
to Excel Liberation
Thanks Bruce. Is that for Google Sheets only?
The UK HMRC site has a complex flow involving client_id, an authorisation token than expires in 4 hours and then needs a refresh token, and different authorisations for different scopes. I've cracked their "Hello World" tutorial but have not succeeded in a tax example, maybe simply missing some resource I should have set up first. Just playing around at this stage anyway.

Bruce Mcpherson

unread,
Aug 23, 2018, 6:53:42 AM8/23/18
to excel-r...@googlegroups.com
It's set up for google end points but can be set up with different ones to. 
.. see the section on makemygoogleconsole in 

It handles refresh tokens - that's pretty standard in oauth flows. 

For more on how oauth2 works in general see these apps script examples




eddie....@gmail.com

unread,
Sep 6, 2018, 10:37:54 PM9/6/18
to Excel Liberation
Dear Bruce,
I have read this stream with interest.  I'm an absolute hack at coding, but I muck around with VBA and cut and modify others' basic code to make my spreadsheets "spiffy". I don't really understand the nomenclature of development such as what is "class" or "property" and the likes, mainly because I don't really need to for the stuff I play with, and because I've not really embarked on learning to code properly.  For the most part I can follow what subroutines are doing and modify them.
Having said that, I've been trying to create a routine that will automatically attach a spreadsheet (or pdf copy) to a gMail email and send it.  I have some working code i modified that uses CDO, but I'm not thrilled at having lesser security on my google account.  I then started me research and found references to oAuth that gmail uses.  I get the concept. And I get confused around JSON, Chilkat and the nuts and bolts.
Kyle's code appears to be part of my solution, but I have no Idea how to use it. What I like is to press a button and either authenticate and send with stored credentials (bit of a risk) or to have the google authentication window pop up and once authenticated have the email ready to send.

below is what I have done
Option Explicit
Sub Prev()
Range("EndDate") = Range("EndDate") - 14
End Sub


Sub Nxt()
Range("EndDate") = Range("EndDate") + 14
End Sub


Sub SaveAndSend()


   
'creates a new invoice number based on date in specified cell & creates new folder if necessary
    '
finds next unused invoice number & verifies that file is properly saved


   
Const fNameExt = ".pdf"            ' file extension


    Dim fPrefix, fName, fPath, EndDate, eBody, eSubject, strEmail As String
    Dim iMsg, iConf As Object
    Dim Flds As Variant
   
'
************** SET PARAMETERS *********************

    fPath
= Application.ActiveWorkbook.Path & "\TIMESHEETS\"
    EndDate = "
ENDING " & Format(Range("EndDate"), "DD-MM-YY")
    fPrefix = Format(Range("
EndDate"), "YYMM")
    fName = Dir(fPath & fPrefix & "
-*.pdf")
    eSubject = Range("
LocumName") & "TIME SHEET " & EndDate
    eBody = "
Please find timesheet ending " & Range("EndDate") & "attached"
    strEmail = "
mailto:" & Range("payroll") & "?cc=" & Range("ccEmail") & "&subject=" & eSubject & "&body=" & eBody & "&attachment=" & fName
    'gMailAddr = Range("
gMail")
    'gMAilPass = Range("
gMailPass")
   
'************** CHECK END DATE EXISTS **************

    If Range("
EndDate") = "" Then
        MsgBox "
End date is blank"
        Exit Sub
        Range("
EndDate").Select
    End If
   
'************** CHECK IF FOLDER EXISTS *************

    If Dir(fPath, vbDirectory) = "" Then            'folder not found - create folder?
        If MsgBox("
Okay to create folder " & fPath & " for timesheet " & fPrefix & "- " & EndDate, _
                vbOKCancel + vbQuestion, "
Folder not Found") <> vbOK Then Exit Sub
                MkDir (fPath) 'create folder
    End If
           
'*************** SAVE THE FILE AS PDF **************

    fName = fPath & fPrefix & "
- TIMESHEET " & EndDate & ".pdf"
    Debug.Print "
Saving as: " & fName
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName, Quality _
        :=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
   
'**************** DOUBLE CHECK FILE EXISTS ************

    If Dir(fName) = "" Then
        Call MsgBox("
ERROR! FILE NOT SAVED: " & fName, vbCritical + vbOKOnly, "ERROR!")
        Stop
    End If

'**************** CREATE EMAIL ************************

 If MsgBox("
email " & Range("payroll") & " cc " & Range("ccemail"), _
                vbOKCancel + vbQuestion, "
Folder not Found") <> vbOK Then Exit Sub
    Set iMsg = CreateObject("
CDO.Message")
    Set iConf = CreateObject("
CDO.Configuration")


    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields
    With Flds
        .Item("
http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
       
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
       
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Range("gMail")
       
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Range("gMailPass")
       
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
       
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
       
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
       
.Update
   
End With

   
With iMsg
       
Set .Configuration = iConf
       
.To = Range("Payroll")
       
.CC = Range("ccEmail")
       
' Note: The reply address is not working if you use this Gmail example
        '
It will use your Gmail address automatic. But you can add this line
       
' to change the reply address  .ReplyTo = "Reply@otherEmail"
        .From = """Eddie
"" <Eddie's Email>"
        .Subject = eSubject
        .TextBody = eBody
        .AddAttachment fName
        .send
    End With
   
    Set iMsg = Nothing
    Set iConf = Nothing
    Set Flds = Nothing

'***************** SUCCESS MESSAGE ********************

    Call MsgBox("
Timesheet saved successfully:" & vbLf & vbLf & fName, vbInformation, "Timesheet Created and sent")
   
End Sub


Help would be great.

Regards,
Eddie

Bruce Mcpherson

unread,
Sep 7, 2018, 4:13:10 AM9/7/18
to excel-r...@googlegroups.com
Hi Eddie

This forum has actually been closed for some years now and migrated to g+ 


What you are trying to do is just a few lines of code in Apps Script (assuming your PDF files are on Drive or have been automatically synced to drive) as the whole business of OAuth is built in - so that's by far the simplest solution. 

There are a number of problems with OAUTH2 from VBA
  • It doesn't natively understand JSON
  • The OAUTH flow conversation from VBA requires a bit of a hack into the IE object that can be troublesome with the different versions of IE and Excel version combinations
  • You need access to the registry to store secrets (sometimes this is locked down)
  • You need to be able to post from VBA - again this is sometimes locked down - and sometimes its locked down to all but the server version of that object by some adminsitrators.
Rakesh sarma did a a guest post on my site on how to get round some of these corporate blockers


Having said all that, there are many people using this solution successfully to access all kinds of Google resources from VBA - if you go to my site mcpher.com and search for getgoogled, you'll find a number of references to how.

It works like this
- you set up a project in your google cloud console
- you use a one off function to store those credentials in your registry
- to be able to talk to google you need a access token - getgoogled will take care of the gory details of that and access your registry to find the credentials and either give you an unexpired one it already has, refresh an expired one, or take you through a google authorization dialog during which you give permission to access the google resources. you need - in this case you'd be using the gmail API and would need access to the scopes associated with sending a mail. 

As I said all this can be rather complex, for a problem that can easily be solved using Apps Script - this is all you need to do to send a mail with an attachment.
GmailApp.sendEmail(
      "br...@mcpher.com", 
      "Heres something", 
      "See the attachment", { 
        attachments:[fileBlob]
      });

I wrote a book on the transition from VBA to Apps script, http://shop.oreilly.com/product/0636920045816.do# if you are interested in diving deeper into that.

bruce



For more options, visit https://groups.google.com/d/optout.

mo...@e-2go.net

unread,
Feb 4, 2019, 8:28:17 AM2/4/19
to Excel Liberation
Hi

How did you get on with this?
I'm in the middle of building a spreadsheet in preparation for MTD. I've managed to get the refresh token but I'm not sure I'm storing my tokens properly...

Patrick O'Beirne

unread,
Apr 4, 2019, 7:54:54 AM4/4/19
to Excel Liberation
I've done the Hello World/User demos for MTD and can publish them once they've been tested by someone else.
The refresh token should be stored in the Registry but I store it in a cell for simplicity.

ashus...@gmail.com

unread,
Jul 11, 2019, 3:34:10 AM7/11/19
to Excel Liberation
Hello. I want to thank you for your libraries and allowing me push data from Excel to GoogleSheets.  I am in the middle of a project right now and realize that even when I use the sheetApi libraries/code I am still having problems pushing the formatting of my excel sheet over to my google sheet.  Its only copying the values.  Is there something I can modify to do this?  Perhaps there is an updated sheet to download.

Thanks,
Regards,
Ashu

On Tuesday, July 9, 2013 at 10:44:59 AM UTC-7, Kyle Beachill wrote:
Hi Bruce,

I was just about to start work helping someone on another forum that requires OAuth2.0 for Google integration, I haven't seen an Excel client for it - but before I got cracking on it; it occurred to me that this is the kind of thing that you may have done already ;) If so, could you point me towards it on your site (I couldn't find anything with a search), if not would you mind sharing some of your musings/plan of attack?

Excel isn't a particularly easy client, but my thoughts/ramblings are that I'm going to either need an integrated webbrowser or to automate IE - from an experience point of view I quite like an integrated browser, but to keep things lightweight I'll probably go for IE automation, then it's just a case of caching the refresh tokens and checking expiry before firing off requests.


Thanks 

Kyle



royl...@gmail.com

unread,
Mar 30, 2020, 11:59:09 PM3/30/20
to Excel Liberation
I have a quick question, is it possible to use the Excel VBA Oauth2 Google code: OAuth 2.0 Google Authenticator, but instead of using XML using JSON??  I'm trying to authenticate using Riskalyze.com's API and their documentation states it is JSON only.  I'm a very basic VBA "programmer" (trust me I have to put that in quotes!).  Thanks for any help or advice!
Tony R

Bruce Mcpherson

unread,
Mar 31, 2020, 5:35:20 AM3/31/20
to excel-r...@googlegroups.com
This works with JSON, using my cObject class to work with JSON style objects in VBA, so you should be able to use that to make JSON for any purpose.

There are some examples around that on how to oauth2 to a rest api from excel. I haven;t looked at that code for a few years, but presumably it still works.


--
You received this message because you are subscribed to the Google Groups "Excel Liberation" group.
To unsubscribe from this group and stop receiving emails from it, send an email to excel-ramblin...@googlegroups.com.

royl...@gmail.com

unread,
Mar 31, 2020, 5:21:12 PM3/31/20
to excel-r...@googlegroups.com

Thank you very much for the help and advice!  It’s truly appreciated!  I’m sure I’ll have plenty of questions in this implementation.  Thank you for the resources and response!

Regards,

Tony R

--
You received this message because you are subscribed to a topic in the Google Groups "Excel Liberation" group.
To unsubscribe from this topic, visit https://groups.google.com/d/topic/excel-ramblings/sm19u_UWVHg/unsubscribe.
To unsubscribe from this group and all its topics, send an email to excel-ramblin...@googlegroups.com.
To view this discussion on the web, visit https://groups.google.com/d/msgid/excel-ramblings/CANijH0VHHT%3DfBzKhRPidFrZXjawgkC4PEiE4Gy7-e5HDtevY5A%40mail.gmail.com.

Reply all
Reply to author
Forward
0 new messages