VBA关闭IE javascript弹出窗口

时间:2018-06-18 23:36:11

标签: excel vba excel-vba web-scraping

以下代码打开InternetExplorer的实例并下载赔率。它工作正常但偶尔会出现一个弹出窗口,导致代码无法正常工作。当弹出窗口出现时,如何导航下面的弹出窗口(即点击“继续使用oddschecker'”)有任何帮助吗?

<a class="continue beta-callout js-close-class" onclick='s_objectID="javascript:void(0)_9";return this.s_oc?this.s_oc(e):true' href="javascript:void(0)">Continue to Oddschecker</a>

完整代码:

Sub Oddschecker()

Dim ie, wp As Object
Dim i As Integer

Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = False
ie.Navigate "https://www.oddschecker.com/horse-racing/racing-coupon"

Do While ie.Busy
    DoEvents
Loop

Do While ie.ReadyState <> 4
    DoEvents
Loop

Set wp = ie.Document

'Application.ActiveSheet.UsedRange.ClearContents
Application.Worksheets("sheet1").UsedRange.ClearContents

i = 2
For Each rw In wp.getElementsByTagName("table")(0).getElementsByTagName("tr")
    If rw.className = "date" Then
        Worksheets("sheet1").Range("A1") = rw.innerText
    ElseIf rw.className = "fixture-name" Then
        i = i + 1
        Worksheets("sheet1").Range("A" & i) = rw.getElementsByTagName("td")(0).innerText
        i = i + 1
    ElseIf rw.className = "coupons-table-row match-on" Then
        For Each od In rw.getElementsByTagName("p")
            If InStr(od.innerText, "(") <> 0 Then
                Worksheets("sheet1").Range("A" & i) = Trim(Left(od.innerText, InStr(od.innerText, "(") - 1))
                np = Trim(Right(od.innerText, Len(od.innerText) - InStr(od.innerText, "(")))
                Worksheets("sheet1").Range("B" & i) = Left(np, Len(np) - 1)
                i = i + 1
            Else
                Worksheets("sheet1").Range("A" & i) = Trim(od.innerText)
                i = i + 1
            End If
        Next od

    End If
Next rw

ie.Quit

Range("A1:B" & i).WrapText = False
Columns("A:B").EntireColumn.AutoFit

Set wp = Nothing
Set ie = Nothing


End Sub

1 个答案:

答案 0 :(得分:1)

如果您希望继续该页面(导航到该弹出页面),您可以尝试:

Dim HTML As HTMLDocument, addcheck As Object

While IE.Busy = True Or IE.readyState < 4: DoEvents: Wend ''(You can write it the way you feel comfortable)
Set HTML = IE.document  ''place this line after the prevous line

Set addcheck = HTML.querySelector("#promo-modal a.continue")
If Not addcheck Is Nothing Then
    addcheck.Click
End If

但是,这不是一个好主意,因为它会引导您进入某个页面,您可能需要执行某些操作才能返回此数据链接页面。

我想你应该通过勾选位于右上角区域的十字按钮来摆脱那个弹出窗口拦截器并继续做你正在做的事情:

Dim HTML As HTMLDocument, addcheck As Object

While IE.Busy = True Or IE.readyState < 4: DoEvents: Wend ''(You can write it the way you feel comfortable)
Set HTML = IE.document  ''place this line after the prevous line

Set addcheck = HTML.querySelector("#promo-modal span[title='Close")
If Not addcheck Is Nothing Then
    addcheck.Click
End If

如果我不明白你的意图,请告诉我。感谢。