HTML Запрос веб-страницы с различными параметрами поиска - PullRequest
Новая
       16

HTML Запрос веб-страницы с различными параметрами поиска

1 голос
/ 10 марта 2020

Я пытаюсь импортировать данные с веб-сайта, который требует определенных параметров поиска. На выбор предлагается около 5 вариантов. Я пытаюсь создать сценарий, который будет запрашивать веб-сайт, выбрать параметры поиска c и поиск. Оттуда импортируйте результаты в мой лист Excel.

Код, который я создал, не работает. Я новичок в VBA, поэтому буду признателен за помощь.

Вот что у меня есть: 

Private Sub RegulatoryDataPull_Click()

Dim eRow As Long
Dim objIE As Object
Dim HDoc As HTMLDocument
Dim HEle As HTMLUListElement

Set objIE = CreateObject("InternetExplorer.Application") ' Create document object.
Set HDoc = objIE.document ' Create HTML element (<ul>) object.
Set HEle = HDoc.getElementById("dnn_ctr85406_StateNetDB_resultsCount") ' Get the element reference using its ID.

Set sht = Sheets("Sheet1")

eRow = Sheet1.Cells(Rows.Count, 7).End(x1Up.Offset(7, 0)).Row

With objIE
.Visible = True
.navigate "https://www.ncsl.org/research/energy/energy-legislation-tracking-database.aspx"

Do While .Busy Or _
.readyState <> 4
DoEvents
Loop

Var arr = [document.querySelectorAll('["name=dnn$ctr85406$StateNetDB$ckBxTopics$16"],[name="dnn$ctr85406$StateNetDB$ckBxTopics$5"],[name="dnn$ctr85406$StateNetDB$ckBxTopics$3"],[name="dnn$ctr85406$StateNetDB$ckBxTopics$8"]')]
Topics.Item(0).Value = Topicchoice

Set States = .document.getElementsByName("dnn$ctr85406$StateNetDB$ckBxAllStates")
States.Item(0).Value = Stateschoice

Set Status = .document.getElementsByName("dnn$ctr85406$StateNetDB$ddlStatus")
Status.Item(0).Value = Statuschoice

Set Year = .document.getElementsByName("dnn$ctr85406$StateNetDB$ddlYear")
Year.Item(0).Value = Yearchoice

.document.getElementById("dnn_ctr85406_StateNetDB_btnSearch").Click

Do While .Busy Or _
.readyState <> 4
DoEvents
Loop

Dim ele As Object

' Loop through elements inside the <ul> element and find <br>, which has the texts we want.
With HEle
    For ele = 0 To .getElementsByTagName("br").Length - 1
        Debug.Print .getElementsByTagName("br").Item(ele).getElementsByTagName("br").Item(0).innerHTML
    End Select
    Next ele

End With

Set objIE = Nothing

End Sub

1 Ответ

0 голосов
/ 12 марта 2020

Добро пожаловать на ТАК! Я скопировал ваш код в Excel-VBA, и он действительно вылетел. В этом случае проще всего пройти через F8 (не просто запускать код кнопкой F5 / a). Это помогает найти строку, где код блокируется / падает. После некоторых модификаций я разработал этот код, который работает на моей машине. Это ни в коем случае не закончено, но должно дать вам хорошее начало. 

Private Sub RegulatoryDataPullTWO()

Dim eRow As Long
Dim objIE As Object
Dim HDoc As HTMLDocument
Dim HEle As HTMLUListElement

Set objIE = CreateObject("InternetExplorer.Application") ' Create document object.
objIE.Visible = True
objIE.navigate "https://www.ncsl.org/research/energy/energy-legislation-tracking-database.aspx"

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

Set HDoc = objIE.document ' Create HTML element (<ul>) object.

Set Top1 = objIE.document.getElementsByName("dnn$ctr85406$StateNetDB$ckBxTopics$16")
Top1.Item(0).Value = True

Set States = objIE.document.getElementsByName("dnn$ctr85406$StateNetDB$ckBxAllStates")
States.Item(0).Value = True

Set Status = objIE.document.getElementsByName("dnn$ctr85406$StateNetDB$ddlStatus")
Status.Item(0).Value = "Adopted"

Set yr = objIE.document.getElementsByName("dnn$ctr85406$StateNetDB$ddlYear")
yr.Item(0).Value = "2019"

objIE.document.getElementById("dnn_ctr85406_StateNetDB_btnSearch").Click

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

Set HEle = HDoc.getElementById("dnn_ctr85406_StateNetDB_resultsCount") ' Get the element reference using its ID.
Set HList = HDoc.getElementById("dnn_ctr85406_StateNetDB_linkList")
Set Sht = Sheets("Sheet1")

Debug.Print HEle.outerText
Sht.Range("B2").Value = HEle.outerText
ResRw = 3
For e = 0 To HList.getElementsByTagName("a").Length - 1
    Set lnk = HList.getElementsByTagName("a").Item(e)
    'Debug.Print e1.outerText, e1.outerHTML
    If lnk.outerText <> "Bill Text Lookup" And lnk.outerText <> "*" Then
        Debug.Print Replace(Replace(lnk.ParentNode.innerText, Chr(10), ""), Chr(13), "")
        Debug.Print lnk.ParentNode.NextSibling.NextSibling.innerText
        Sht.Range("A" & ResRw).Value = Replace(Replace(lnk.ParentNode.innerText, Chr(10), ""), Chr(13), "")
        Sht.Range("B" & ResRw).Value = lnk.ParentNode.NextSibling.NextSibling.innerText
        ResRw = ResRw + 1
    End If
Next e

Set objIE = Nothing

End Sub
...