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

时间:2019-10-01 09:02:08

标签: vba web-scraping

起初,我认为经过一些学习和熟悉VBA可以轻松构建基于vba的小型Web抓取工具,但是,我完全错了。

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

我需要输入3个值,“ Period”日期(可以)并选择“ Flag”(在本例中为“葡萄牙”)。事实证明这最后一个困难很大,因为打字甚至都不是选择。

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

到目前为止没有任何工作。我真的很感谢您的一些知识。 祝一切顺利, 爱德华多

2 个答案:

答案 0 :(得分: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

答案 1 :(得分:0)

与此同时,我尝试了另一种选择,但仍然没有成功:

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
相关问题