在带有VBA的下拉列表中单击元素

时间:2018-07-26 07:09:28

标签: excel vba web-scraping kendo-ui

我正在编写VBA代码,以在Wesbite上抓取数据。我可以在文本框中更改数据,但不能单击下拉列表中的元素,然后获取所需的数据。 请帮我代码有什么问题 该网站为https://www.truckbhada.com/CalculateFreight

Sub SearchBot()

Dim objIE As InternetExplorer 
Dim aEle As HTMLLinkElement 
Dim elem As Object, post As Object
Dim x As Long
Dim y As Long


Set objIE = New InternetExplorer


objIE.Visible = True


objIE.navigate "https://www.truckbhada.com/CalculateFreight"


Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop

For x = 2 To 20
       objIE.document.getElementById("txtSourceRoute").Value = Sheets("Sheet1").Range("A" & x).Value

    objIE.document.getElementById("txtDestinationRoute").Value = Sheets("Sheet1").Range("B" & x).Value

    Set post = objIE.document.getElementById("ddlTruckType")

    y = 3

    For Each elem In post.getElementsByTagName("option")
        elem.Selected = True

        'elem.Click
        Debug.Print elem.innerText
        Debug.Print objIE.document.getElementById("ContentPlaceHolder1_Label11").innerText
        Cells(x, y) = objIE.document.getElementById("ContentPlaceHolder1_Label11").innerText
        y = y + 1
    Next elem

Next x

objIE.document.getElementById("ContentPlaceHolder1_Label11").innerText

End Sub

运行此代码时,freightvalue不会更新。请帮助我

2 个答案:

答案 0 :(得分:1)

1)IE解决方案

Option Explicit  
Public Sub GetMakeSelections()
    Dim IE As New InternetExplorer, html As HTMLDocument
    Const optionWanted As Long = 1               'Tate Ace ZIP(0.6 ton)
    With IE
        .Visible = True
        .navigate "https://www.truckbhada.com/CalculateFreight"

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

        Set html = .document
        With html
            .querySelector("#txtSourceRoute").Focus
            .querySelector("#txtSourceRoute").innerText = "Surat, Gujarat, India"
             Application.SendKeys "{ENTER}"
            .querySelector("#txtDestinationRoute").Focus
            .querySelector("#txtDestinationRoute").innerText = "Faridabad, Haryana, India"
             Application.SendKeys "{ENTER}"
            .querySelector("#form1 span.k-input").Click
            Application.SendKeys "{DOWN " & optionWanted & "}"
            .querySelector("#form1 span.k-input").FireEvent "onmouseover"
            .querySelector("#form1 span.k-input").FireEvent "onsubmit"
            Application.SendKeys "{TAB}"
            Debug.Print .querySelector(".form-group").innerText
        End With
        .Quit '<== Remember to quit application
    End With
End Sub

网页视图:

Web view


英国设置立即窗口打印输出:

Output


参考:

HTML对象库


2)Selenium basic解决方案:

Option Explicit
Public Sub GetInfo()
    Dim d As WebDriver, keys As New Selenium.keys
    Set d = New ChromeDriver
    Const Url = "https://www.truckbhada.com/CalculateFreight"
    Const OPTION_WANTED As Long = 3
    With d
        .Start "Chrome"
        .get Url
        .FindElementById("txtSourceRoute").SendKeys "Surat, Gujarat, India"
        .FindElementById("txtSourceRoute").SendKeys keys.Enter
        .FindElementById("txtDestinationRoute").SendKeys "Faridabad, Haryana, India"
        .FindElementById("txtDestinationRoute").SendKeys keys.Enter
        .FindElementByCss("#form1 span.k-input").Click
        Application.SendKeys "{DOWN " & OPTION_WANTED & "}"
        Application.SendKeys "{TAB}"
        Debug.Print .FindElementByCss(".form-group").Text
        .Quit
    End With
End Sub

网页视图:

web page


英国设置立即窗口打印输出:

immediate window


需要参考:

硒类型库

答案 1 :(得分:0)

尝试一下

 For Each elem In post.getElementsByTagName("option")

        If elem.Value <> "Select TruckType" Then

            post.FireEvent "onmouseover"
            elem.Selected = True
            objIE.document.parentWindow.execScript "$('#ddlTruckType').kendoDropDownList()"

            Application.Wait 10

            Do Until objIE.document.getElementById("ContentPlaceHolder1_Label11").innerText <> "0.0/-" _
               And objIE.document.getElementById("ContentPlaceHolder1_Label11").innerText <> "0/-"
                post.FireEvent "onchange"
                DoEvents
            Loop


            Debug.Print elem.innerText
            Debug.Print objIE.document.getElementById("ContentPlaceHolder1_Label11").innerText
            Cells(x, y) = objIE.document.getElementById("ContentPlaceHolder1_Label11").innerText
            y = y + 1

        End If
    Next elem