使用 VBA 从下拉菜单中选择选项答案

【问题标题】：Select option from dropdown menu with VBA使用 VBA 从下拉菜单中选择选项
【发布时间】：2020-02-15 20:01:12
【问题描述】：

我正在尝试从这个网站上抓取数据：https://portal.emsa.europa.eu/widget/web/thetis/inspections/-/publicSiteInspection_WAR_portletpublic

我需要输入三个值，即“期间”日期（可以）并选择“标志”（在本例中为葡萄牙）。最后一个已被证明是一个巨大的困难，因为打字不是一种选择。

Private Sub Run()

Dim objIE As Object
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Visible = True

objIE.navigate ("https://portal.emsa.europa.eu/widget/web/thetis/inspections/-/publicSiteInspection_WAR_portletpublic")

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

objIE.document.getElementById("tdate-1028-inputEl").Value = "01/01/2019"
objIE.document.getElementById("tdate-1029-inputEl").Value = "01/09/2019"
objIE.document.getElementById("checkcombo-1014-trigger-picker").Click
If objIE.document.getElementByClass("x-boundlist-item") = """Portugal""" Then objIE.document.getElementBy("x-combo-checker").Click
End Sub

【问题讨论】：

你为什么不试试XMLHttpRequest 而不是IE？您可以发送带有适当参数的 post http 请求，并从 json 响应中解析出所需的结果。如果您仍然想坚持使用任何浏览器模拟器，请尝试选择 selenium。
我听从了你的建议，但这比我的知识还要深。到目前为止，我可以找到如何/在哪里发送信息。任何机会你都可以给我一些帮助。

标签： vba web-scraping

【解决方案1】：

您想要一个定时循环来等待元素的存在以单击以及先单击父元素。可悲的是，我找不到一种简单的方法来消除在开始时用于完成页面加载的当前显式等待时间

Option Explicit

Public Sub SelectFlag()
    Dim ie As SHDocVw.InternetExplorer, t As Date

    Const MAX_WAIT_SEC As Long = 5               '<==adjust time here
    Set ie = New SHDocVw.InternetExplorer

    With ie
        .Visible = True
        .Navigate2 "https://portal.emsa.europa.eu/widget/web/thetis/inspections/-/publicSiteInspection_WAR_portletpublic"

        While .Busy Or .readyState <> 4: DoEvents: Wend

        With .document
            Application.Wait Now + TimeSerial(0, 0, 5)
            .querySelector("#checkcombo-1014-trigger-picker").Click
            Dim ele As Object
            t = Timer
            Do
                On Error Resume Next
                Set ele = .querySelector("[data-recordid='246']")
                On Error GoTo 0
                If Timer - t > MAX_WAIT_SEC Then Exit Do
            Loop While ele Is Nothing
            If Not ele Is Nothing Then ele.Click
        End With

        Stop                                     '<==Delete me later

        '.quit
    End With

End Sub

【讨论】：

您好@QHarr 再次感谢您的帮助。在这篇文章之后，我学会了如何进行 POST 请求。我找到了一种解析 JSON 响应的方法，然后就完成了！明天把代码发给你。但是您的解决方案也是一个非常好的解决方案！
是的......我也会去 POST 路线，但我想你可能想知道如何实现上述目标 :-)

【解决方案2】：

我同时尝试了另一种选择，但仍然没有成功：

Private Sub Run()

Dim objIE As Object
Set objIE = CreateObject("InternetExplorer.Application")

    objIE.Visible = True
    objIE.navigate ("https://portal.emsa.europa.eu/widget/web/thetis/inspections/-/publicSiteInspection_WAR_portletpublic")

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

Dim iL As IHTMLElement
Dim e As IHTMLElementCollection

Set e = appIE.document.getElementById("checkcombo-1014-picker").getElementsByClass("x-boundlist-item")
For Each iL In e
  If iL.innerText = "Portugal" Then
  iL.Click
  End If
Next iL
End Sub

【讨论】：