OAuth2.0 and Excel

[Kyle Beachill]

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]

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.

http://excelramblings.blogspot.co.uk/2012/09/client-oauth-calls-using-google-apps.html

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

http://ramblings.mcpher.com/Home/excelquirks/snippets/basicauth

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

http://excelramblings.blogspot.co.uk/2013/05/digest-authentication-and-google-apps.html

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]

Thanks Bruce,

Have you come across this before? https://github.com/timhall/Excel-REST/blob/master/authenticators/OAuth2Authenticator.cls

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

Cheers

[Bruce Mcpherson]

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]

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]

looks good .. you're building on the stuff from tim hall's site ?

[Kyle Beachill]

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]

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

Debug.Print o.Query("https://www.googleapis.com/analytics/v3/data/ga?ids=sdfd")

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]

excellent.. i'll play with this over the next few days

thanks Kyle

[Bruce Mcpherson]

Kyle

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

bruce

[Kyle Beachill]

Morning Bruce,

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

[Bruce Mcpherson]

Sure 

even better!

bruce

[Kyle Beachill]

Hi Bruce,

How's this?

' ================================================================================== '

'

' OAuth 2.0 Google Authenticator

' Developed by Kyle Beachill

' licence: MIT (http://www.opensource.org/licenses/mit-license.php)

'

' Inspired loosely by Tim Halls authentication classes in his Excel-Rest library:

' https://github.com/timhall/Excel-REST

'

'

' 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]

yep - do you want to write an introduction paragraph, you have a blog.website to promote etc..?

[Bruce Mcpherson]

Hi Kyle

published your article

http://www.mcpher.com/Home/excelquirks/guests/oauth2

bruce

[Kyle Beachill]

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]

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]

ok - done.

thanks again

bruce

[Kyle Beachill]

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]

Hi Kyle,

Developed this out  a little.

http://ramblings.mcpher.com/Home/excelquirks/googleoauth2

Bruce

[Kyle Beachill]

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]

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]

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]

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?

https://docs.microsoft.com/en-us/azure/active-directory/develop/active-directory-protocols-oauth-code

--
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]

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

https://test-api.service.hmrc.gov.uk/oauth/authorize

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]

OK found it .. I needed to register the redirect URI "urn:ietf:wg:oauth:2.0:oob" at their website.

[Bruce Mcpherson]

There's an example of an alternative approach here

http://ramblings.mcpher.com/Home/excelquirks/exceldocsintegration/excelsheetsv4

--
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]

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]

It's set up for google end points but can be set up with different ones to. 

.. see the section on makemygoogleconsole in 

http://ramblings.mcpher.com/Home/excelquirks/googleoauth2

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

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

http://ramblings.mcpher.com/Home/excelquirks/goa

[eddie....@gmail.com]

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]

Hi Eddie

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

https://plus.google.com/communities/103319333735778985706

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

http://ramblings.mcpher.com/Home/excelquirks/guests/vbaouathsettings

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]

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]

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]

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]

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]

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.

https://ramblings.mcpher.com/google-oauth2-vba-authentication/

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.

To view this discussion on the web, visit https://groups.google.com/d/msgid/excel-ramblings/8ddebd3d-d4d0-48ab-bdff-280dbd62a63f%40googlegroups.com.

[royl...@gmail.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.