HTML Webpage Query with Various Search Parameters

Question

I am attempting to import data from a website that requires certain search parameters. There are a selection of about 5 options that is required on the website. I'm trying to build a script that will query the website, select specific search parameters and search. From there import the results to my excel sheet.

The code I created is not working. I am new to VBA so would appreciate the help.

This is what I have:

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

Answer 1

Welcome to SO! I copy-pasted your code in Excel-VBA and it indeed crashed. In that case the easiest thing to do is step through it with F8 (don't just run the code with F5/a button). That does help in finding the line where the code blocks/crashes. After some modifications I came up with this code that works on my machine. It's by no means finished, but should give you a good start.

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