I have code which opens the login page to our oracle cloud infrastructure instance. However when I click on the single sign on button, it triggers the Internet Explore OnQuit activity which in turn in hampering the execution of the code. We're closely following Kyle Beachill's work (https://ramblings.mcpher.com/guests-articles-and-postings/oauth2-and-vba/). I basically want to capture the authcode in the URL before proceeding to get the token. What is happening now is after getting redirected to the single sign on page, I'm unable to capture the URL using the .LocationURL function.
code to open internet explorer:
Private Sub GetNewToken()
Set oIExplorer = New InternetExplorer
With oIExplorer
.Navigate2 CreateAuthRequest()
.AddressBar = True
.MenuBar = True
.Resizable = True
.Visible = True
End With
Debug.Print ".LocationURL : " & oIExplorer.LocationURL
strAuthCode = ""
Do: DoEvents: Loop Until blnIeComplete
Debug.Print ".LocationURL: " & GetURL
Debug.Print "strAuthCode: " & strAuthCode
'Debug.Print "second request"
'// 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.XMLHTTP60
Debug.Print "second request"
With objXMLRequest
.Open "POST", strTokenUrl, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "User-agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Postman/9.1.4 Chrome/87.0.4280.88 Electron/11.1.1 Safari/537.36"
.send CreateTokenRequest()
If .Status <> 200 Then
'// Error getting OAuth2 token
Err.Raise vbObjectError + .Status, _
Description:="Failed to retrieve OAuth2 Token - " & .Status & ": " & .responseText
End If
Debug.Print ".Status: " & .Status
Debug.Print ".StatusText: " & .StatusText
'// Get the credentials from the response
strToken = GetProp("access_token", .responseText)
Debug.Print "strToken: " & strToken
strRefreshToken = GetProp("refresh_token")
Debug.Print "strRefreshToken: " & strRefreshToken
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 "OracleAuth", "Tokens", "RefreshKey", strRefreshToken
SaveSetting "OracleAuth", "Tokens", "Token", strToken
SaveSetting "OracleAuth", "Tokens", "TokenExpiry", CStr(dtExpiresWhen)
End Sub
OnQuit:
Private Sub oIExplorer_OnQuit()
Debug.Print "Exit title url : " & oIExplorer.LocationURL
Debug.Print "geturl : " & GetURL
Debug.Print "END"
blnIeComplete = True
End Sub
TitleChange:
Private Sub oIExplorer_TitleChange(ByVal text As String)
Debug.Print "title change text : " & text
Debug.Print "title change url : " & oIExplorer.LocationURL
Debug.Print " get url : " & GetURL
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