VBA调用IE点击SSO按钮触发OnQuit事件无法捕获OAuth授权码问题

• IE默认开启跨域进程隔离机制，OCI单点登录属于跨安全域的跳转操作，会销毁你初始化的原有IE进程，启动全新的IE进程加载登录页。你代码中声明的oIExplorer对象绑定的是旧进程，所以跳转时会触发OnQuit事件，旧对象被系统释放后自然无法读取LocationURL属性。
• 现有OnQuit事件逻辑会直接将blnIeComplete置为True，旧进程销毁后直接跳出等待循环，还没等新进程加载完授权页面就终止了捕获逻辑。

方案1：修改IE配置（最简单，无需大幅改代码） #

打开IE浏览器的「Internet选项」：

1. 切到「安全」标签，将Internet、本地Intranet、受信任的站点、受限制的站点四个区域的「启用保护模式」全部取消勾选
2. 切到「高级」标签，取消勾选「在单独的进程中打开弹出窗口」和「启用增强保护模式」
3. 点击确定后重启IE生效，此时跨域跳转不会新开进程，原有oIExplorer对象不会被销毁，OnQuit事件不会异常触发，LocationURL可正常读取。

方案2：动态绑定IE实例（兼容默认IE配置，无需修改用户设置） #

改用ShellWindows遍历所有当前运行的IE进程，不管跳转是否开新进程都能捕获到对应的窗口，无需依赖单个IE实例的事件，示例代码如下：

' 需提前引用：Microsoft Internet Controls、Microsoft Shell Controls And Automation
Private Sub GetNewToken()
    Dim sw As ShellWindows
    Dim ie As InternetExplorer
    Dim blnFound As Boolean
    Dim startTime As Date
    
    Set sw = New ShellWindows
    strAuthCode = ""
    blnFound = False
    startTime = Now()
    
    ' 先打开授权页
    Set ie = New InternetExplorer
    With ie
        .Navigate2 CreateAuthRequest()
        .AddressBar = True
        .MenuBar = True
        .Resizable = True
        .Visible = True
    End With
    
    ' 轮询所有IE窗口找授权结果页，超时时间设为2分钟
    Do While DateDiff("s", startTime, Now()) < 120
        DoEvents
        For Each ie In sw
            ' 过滤非IE浏览器的窗口（ShellWindows会包含资源管理器）
            If TypeName(ie.Document) = "HTMLDocument" Then
                ' 匹配你的授权回调地址域名或者成功/失败页标题，自行替换关键字
                If InStr(1, ie.LocationURL, "你的回调地址关键字") > 0 Then
                    If InStr(1, ie.Document.Title, "Success") > 0 Then
                        strAuthCode = ie.Document.getElementbyid("code").Value
                        blnFound = True
                        ie.Quit
                        Exit For
                    ElseIf InStr(1, ie.Document.Title, "Denied") > 0 Then
                        blnFound = True
                        ie.Quit
                        Exit For
                    End If
                End If
            End If
        Next
        If blnFound Then Exit Do
    Loop
    
    ' 后续逻辑保持不变
    If Len(strAuthCode) = 0 Then
        Err.Raise vbObjectError + 2, _
            Description:="用户取消授权或等待超时"
    End If
    
    If objXMLRequest Is Nothing Then Set objXMLRequest = New MSXML2.XMLHTTP60
    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
            Err.Raise vbObjectError + .Status, _
                Description:="获取OAuth2 Token失败 - " & .Status & ": " & .responseText
        End If
        
        strToken = GetProp("access_token", .responseText)
        strRefreshToken = GetProp("refresh_token")
        dtExpiresWhen = DateAdd("s", CLng(GetProp("expires_in")), Now())
    End With

    SaveSetting "OracleAuth", "Tokens", "RefreshKey", strRefreshToken
    SaveSetting "OracleAuth", "Tokens", "Token", strToken
    SaveSetting "OracleAuth", "Tokens", "TokenExpiry", CStr(dtExpiresWhen)
End Sub

使用该方案可以直接删除原有oIExplorer_OnQuit和oIExplorer_TitleChange事件代码，不需要依赖单个IE实例的事件回调，避免进程销毁带来的异常。

内容的提问来源于stack exchange，提问作者Nirbhay