机器人没有选择组合框的每个元素(VBA / Excel / Webscraping)

时间:2017-02-06 23:16:55

标签: vba excel-vba combobox web-scraping excel

我正在使用VBA / Excel进行简单的webscraping,机器人无法选择组合框的每个元素进行提取。

以下代码的一部分:

Set evtprod = IE.Document.createEvent("HTMLEvents")
evtprod.initEvent "change", True, False

Set lstprod = IE.Document.getElementById(var2)

Set contr = IE.Document.getElementById(var2)
contrn = contr.Length

While iprod < contrn

    lstprod.selectedIndex = iprod
    lstprod.dispatchEvent evtprod

    Sleep 300

    Do
        DoEvents
        Sleep 300
    Loop While IE.Busy Or IE.ReadyState <> READYSTATE_COMPLETE

  ThisWorkbook.Sheets("plan2").Cells(iLineprod, 2) = IE.Document.All.Item("ddlprod").Item(iprod).Value

  Set divs = IE.Document.getElementById("bxcategory")
  value = divs.innertext

   ThisWorkbook.Sheets("plan2").Cells(iLineprod, 5) = Value

    iprod = iprod + 1
    iLineprod = iLineprod + 1

Wend

我认为代码“lstprod.selectedIndex = iprod”有问题,因为当我手动更改iprod例如数字2时,“lstprod.selectedIndex = 2”它会选择combox的第二个元素,但是它没有通过互动。或者问题可能在于“lstprod.dispatchEvent evtprod”。

有关如何弄明白的想法吗?

谢谢是提前

1 个答案:

答案 0 :(得分:0)

所以这就是我采取的方法。

1)创建一个GET请求以提取页面数据。

2)将页面数据存储到临时HTML文件中。

3)使用元素选择器查找下拉列表ID,然后提取属于该ID的所有Option标记。

要使以下解决方案正常工作,请首先添加对MSXML2.ServerXMLHTTP60的引用,否则您将遇到运行代码的问题。

我不确定你是否想要看到可见值(InnerText),例如Alphaville或基础值0106,所以我展示了如何显示两者。

Option Explicit

Public Sub getWebData()
On Error GoTo errhand:
    Dim getReq          As New MSXML2.ServerXMLHTTP60 'Add a reference!
    Dim doc             As Object: Set doc = CreateObject("htmlfile")
    Dim Elements        As Object
    Dim Element         As Object

    With getReq
        .Open "GET", "www.somewebsite.com" 'removed actual site URL
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko"
        .send
        .waitForResponse 2
    End With
    If getReq.Status = 200 Then 'if successful
        doc.body.innerHTML = getReq.responseText
        Set Elements = doc.getElementById("campusDropDownList").getElementsByTagName("option")
        For Each Element In Elements
            Debug.Print Element.Value, Element.innerText
        Next
    End If
    Exit Sub
errhand:
    Debug.Print Err.Description, Err.Number
End Sub