excel - 复制最后一个弹出窗口的内容

Question

我有代码可以打开 IE，使用用户名/密码登录，勾选一些复选框，单击按钮并在弹出窗口中打开报告。

我正在尝试将弹出窗口的内容复制到 Excel 工作表。处理弹出窗口的代码没有检测到 url。

Sub MyRosterApps()
Dim MyHTML_Element As IHTMLElement
Dim HTMLdoc As HTMLDocument

Dim MyHTML_Element As IHTMLElement
Dim MyURL As String
Dim objIE As InternetExplorer, t As Date, nodeList As Object, i As Long
Dim ieIEWindow As SHDocVw.InternetExplorer
Dim y As Integer
Const MAX_WAIT_SEC As Long = 5

'Ignore Errors
On Error GoTo Err_Clear
MyURL = "Not a public URL"

Set MyBrowser = New InternetExplorer
MyBrowser.Silent = True
MyBrowser.navigate MyURL
MyBrowser.Visible = True
Do
    'Wait till finished
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE
Set HTMLdoc = MyBrowser.document

'Enter user / password
HTMLdoc.all.txtUsername.Value = "username" ' Eneter your email id here
HTMLdoc.all.txtPassword.Value = "password" 'Enter your password here
HTMLdoc.all.Item("btnLogin").Click

For Each MyHTML_Element In HTMLdoc.getElementsByName("btnLogin")
    If MyHTML_Element.Type = "submit" Then MyHTML_Element.Click: Exit For
Next

Do
    'Wait till finished
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE

Set HTMLdoc = MyBrowser.document

HTMLdoc.all.Item("ucSkillsPicker_lstSkills_35").Click
HTMLdoc.all.Item("btnShowReport").Click

' The Pop Up windows opens
Do
Loop Until MyBrowser.readyState = READYSTATE_COMPLETE

Set HTMLdoc = MyBrowser.document

' Until here is works fine

' Trying to deal with the Pop Up windows
With objIE
    .Visible = True

    ' I am trying to get the active window url which is the pop up

    .navigate ieIEWindow.LocationURL

    Do While .Busy = True Or .readyState <> 4: DoEvents: Loop

    t = Timer
    Do
        DoEvents
        On Error Resume Next

        ' Go thru DIV classes and find  these two oReportCell .a71

        Set nodeList = .document.querySelectorAll("#oReportCell .a71")
        On Error GoTo 0
        If Timer - t > MAX_WAIT_SEC Then Exit Do

    Loop While nodeList Is Nothing

    If Not nodeList Is Nothing Then

        'Paste the value found in DIV classes in Sheet1

        With ThisWorkbook.Worksheets("Sheet1")
            For i = 0 To nodeList.Length - 1
                .Cells(1, i + 1) = nodeList.Item(i).innerText
            Next
        End With
    End If
    .Quit
End With             

Err_Clear:
    If Err <> 0 Then
        'Debug.Assert Err = 0
        Err.Clear
        Resume Next
    End If

End Sub

下面的代码与上面是分开的。如果我像这样跑，它会满足我的需要。当然，我必须粘贴目标窗口 url。

.navigate "url of the pop up window"

问题是弹出窗口 url 过期或类似的东西。一段时间后，页面说我必须通过选择一些复选框并提交。

Option Explicit

Public Sub GrabLastNames()
Dim objIE As InternetExplorer, t As Date, nodeList As Object, i As Long
Const MAX_WAIT_SEC As Long = 5
Set objIE = New InternetExplorer

With objIE
    .Visible = True
    ' Paste targeted window. In my case is the pop up window
    .navigate "url of the pop up window"

    Do While .Busy = True Or .readyState <> 4: DoEvents: Loop

    t = Timer
    Do
        DoEvents
        On Error Resume Next
        Set nodeList = .document.querySelectorAll("#oReportCell .a71")
        On Error GoTo 0
        If Timer - t > MAX_WAIT_SEC Then Exit Do

    Loop While nodeList Is Nothing

    If Not nodeList Is Nothing Then
        With ThisWorkbook.Worksheets("Sheet3")
            For i = 0 To nodeList.Length - 1
                .Cells(1, i + 1) = nodeList.item(i).innerText
            Next
        End With
    End If
    .Quit
End With
End Sub

标签： excelvba