如何使用excel vba點擊彈出的交互式對話框？

Question

我正在嘗試使用 excel vba 從該網站導航和導出數據。 我可以單擊 2018、2019 按鈕和設置選項，但無法使用 vba 單擊“導出數據”選項。 我在下面附上我的代碼供您參考。

    Option Explicit

    Sub GetURLOfFrame()

    Dim IE As New SHDocVw.InternetExplorer
    Dim webpage As MSHTML.HTMLDocument

    IE.Visible = True
    IE.navigate "https://www.epa.gov/fuels-registration-reporting-and-compliance-help/rin-trades-and-price-information"
        Dim t As Date, ele As Object 'waiting
        Const MAX_WAIT_SEC As Long = 10 '<==Adjust wait time

        While IE.Busy Or IE.readyState < 4: DoEvents: Wend
        t = Timer
        Do
            DoEvents
            On Error Resume Next
                Set ele = IE.document.getElementById("show-service-popup-dialog")
                If Timer - t > MAX_WAIT_SEC Then Exit Do
            On Error GoTo 0
        Loop While ele Is Nothing
        Application.Wait (Now + TimeValue("0:00:10"))

    Set webpage = IE.document
    Dim wkb As Workbook, wksRIN As Worksheet, wksFrames As Worksheet
    Set wkb = ThisWorkbook
    Set wksRIN = wkb.Sheets("RIN Trades and Prices")

    Dim Frame As MSHTML.IHTMLElement
    Set Frame = webpage.getElementsByTagName("iframe")(1)


    Dim URL As String
    URL = Frame.getAttribute("src") 'storing the link to the frame

    IE.navigate URL 'goes to the iframe site
        While IE.Busy Or IE.readyState < 4: DoEvents: Wend
        t = Timer
        Do
            DoEvents
            On Error Resume Next
                Set ele = IE.document.getElementById("content")
                If Timer - t > MAX_WAIT_SEC Then Exit Do
            On Error GoTo 0
        Loop While ele Is Nothing
        Application.Wait (Now + TimeValue("0:00:10"))

    Dim htmlarticle As MSHTML.IHTMLElement
    Set htmlarticle = webpage.getElementsByTagName("article")(0)

    Application.Wait (Now + TimeValue("0:00:02"))

    Dim buttons As MSHTML.IHTMLElementCollection
    Set buttons = htmlarticle.getElementsByClassName("lui-buttongroup ng-scope")(0).getElementsByTagName("button")
    buttons(buttons.Length - 2).Click 'clicking the second last year
    buttons(buttons.Length - 1).Click 'clicking the latest year

    Application.Wait (Now + TimeValue("0:00:02"))

    Dim SettingButton As MSHTML.IHTMLElement
    Set SettingButton = htmlarticle.getElementsByClassName("cl-icon cl-icon--cogwheel cl-icon-right-align")(0)
    SettingButton.Click

    Dim SettingOptions As MSHTML.IHTMLElementCollection, ExportDataButton As MSHTML.IHTMLElement, button As MSHTML.IHTMLElement
    Set SettingOptions = webpage.getElementsByClassName("qv-contextmenu ng-scope")(0).getElementsByTagName("li")

    Application.Wait (Now + TimeValue("0:00:05"))

    Set ExportDataButton = webpage.getElementsByClassName("qv-contextmenu ng-scope")(0).getElementsByTagName("li")(0)
    ExportDataButton.Focus
    ExportDataButton.Click

    IE.Quit
    Set IE = Nothing

End Sub

當我運行“ExportDataButton.Click”時，似乎什么也沒發生，我不確定原因。 也不可能直接從表中的數據中抓取，因為 td 的內部文本的值是動態的，並且會隨着您向下滾動表而發生變化。

無法點擊“導出數據”

Answer 1

你做得很好，直到你需要幫助。 代碼提示。 在宏的頭部聲明所有變量。 這更清楚，其他閱讀您代碼的人會更專注。

我認為從 html 表中獲取所有值會更容易。 但是你已經做了很好的基礎工作。 所以我按照你開始的方式完成了你的宏。 我評論了我添加的代碼。

Sub GetURLOfFrame()

    Dim IE As New SHDocVw.InternetExplorer
    Dim webpage As MSHTML.htmlDocument

    IE.Visible = True
    IE.navigate "https://www.epa.gov/fuels-registration-reporting-and-compliance-help/rin-trades-and-price-information"
        Dim t As Date, ele As Object 'waiting
        Const MAX_WAIT_SEC As Long = 10 '<==Adjust wait time

        While IE.Busy Or IE.readyState < 4: DoEvents: Wend
        t = Timer
        Do
            DoEvents
            On Error Resume Next
                Set ele = IE.document.getElementById("show-service-popup-dialog")
                If Timer - t > MAX_WAIT_SEC Then Exit Do
            On Error GoTo 0
        Loop While ele Is Nothing
        Application.Wait (Now + TimeValue("0:00:10"))

    Set webpage = IE.document
    Dim wkb As Workbook, wksRIN As Worksheet, wksFrames As Worksheet
    Set wkb = ThisWorkbook
    Set wksRIN = wkb.Sheets("RIN Trades and Prices")

    Dim Frame As MSHTML.IHTMLElement
    Set Frame = webpage.getElementsByTagName("iframe")(1)


    Dim URL As String
    URL = Frame.getAttribute("src") 'storing the link to the frame

    IE.navigate URL 'goes to the iframe site
        While IE.Busy Or IE.readyState < 4: DoEvents: Wend
        t = Timer
        Do
            DoEvents
            On Error Resume Next
                Set ele = IE.document.getElementById("content")
                If Timer - t > MAX_WAIT_SEC Then Exit Do
            On Error GoTo 0
        Loop While ele Is Nothing
        Application.Wait (Now + TimeValue("0:00:10"))

    Dim htmlarticle As MSHTML.IHTMLElement
    Set htmlarticle = webpage.getElementsByTagName("article")(0)

    Application.Wait (Now + TimeValue("0:00:02"))

    Dim buttons As MSHTML.IHTMLElementCollection
    Set buttons = htmlarticle.getElementsByClassName("lui-buttongroup ng-scope")(0).getElementsByTagName("button")
    buttons(buttons.Length - 2).Click 'clicking the second last year
    buttons(buttons.Length - 1).Click 'clicking the latest year

    Application.Wait (Now + TimeValue("0:00:02"))

    Dim SettingButton As MSHTML.IHTMLElement
    Set SettingButton = htmlarticle.getElementsByClassName("cl-icon cl-icon--cogwheel cl-icon-right-align")(0)
    SettingButton.Click

    Dim SettingOptions As MSHTML.IHTMLElementCollection, ExportDataButton As MSHTML.IHTMLElement, button As MSHTML.IHTMLElement
    Set SettingOptions = webpage.getElementsByClassName("qv-contextmenu ng-scope")(0).getElementsByTagName("li")

    'Application.Wait (Now + TimeValue("0:00:05")) 'Not needed

    'The fifth li-tag is "Export data"
    Set ExportDataButton = webpage.getElementsByClassName("qv-contextmenu ng-scope")(0).getElementsByTagName("li")(4)
    'There is no focus and no click event
    'There are the two events keypress and qv-activate
    'We must trigger qv-activate to get the download popup
    '(See function TriggerEvent to understand what we do here)
    Call TriggerEvent(webpage, ExportDataButton, "qv-activate")
    'Give the popup time to raise
    Application.Wait (Now + TimeValue("0:00:01"))

    'I do it like you here, but it's much better to declare all variables in the head of the macro
    Dim lastIsDownloadLink As MSHTML.IHTMLElementCollection
    'The download link has the css class ng-binding. 101 elements has these css class
    'But the code for the popup is generated after clicking 'Export data' at the end of the HTML document
    'So we can be sure that the last element with the CSS class contains our searched link
    Set lastIsDownloadLink = webpage.getElementsByClassName("ng-binding")
    lastIsDownloadLink(lastIsDownloadLink.Length - 1).Click
    'Give the server time to generate the document and the IE to show the download button in the footer
    Application.Wait (Now + TimeValue("0:00:03"))

    'Attention!
    'We have to use SendKeys to perform the download!!!
    'As long as the macro is running, keep your fingers away from the mouse and keyboard!!!
    '
    'I've tryed to use the URLDownloadToFile method from the urlmon.dll but that don't work
    'I'm sure the server blocks download questions from other applications than that one who
    'has generated the download url with. I tryed it also with FireFox and there comes the text,
    'that the requestet resource is not available. But the same link works at the same time in IE.
    'You will find the download in the download folder of your system
    Application.SendKeys ("%{S}")

    'IE.Quit
    'Set IE = Nothing
End Sub

這是觸發 html 事件的過程：

Private Sub TriggerEvent(htmlDocument As Object, htmlElementWithEvent As Object, eventType As String)

  Dim theEvent As Object

  htmlElementWithEvent.Focus
  Set theEvent = htmlDocument.createEvent("HTMLEvents")
  theEvent.initEvent eventType, True, False
  htmlElementWithEvent.dispatchEvent theEvent
End Sub