[英]How to use VBA Excel Code to display a pop-up message to users that have out of date information
[英]How to use excel vba to click on interactive dialog pop-up?
我正在尝试使用 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 的内部文本的值是动态的,并且会随着您向下滚动表而发生变化。
你做得很好,直到你需要帮助。 代码提示。 在宏的头部声明所有变量。 这更清楚,其他阅读您代码的人会更专注。
我认为从 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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.