How to scrape option values from a website using VBA

Question

I am trying to fetch the names and values of locations from a website page. For example: I want to take the value 10 and label " Johannesburg OR Tambo International Airport" and insert it into cell B3 and B4 respectively and then loop it for all optgroups. I get an error "Object doesn't support this property or method." Im sure my code has multiple issues. any assistance will be greatly appreciated. My code is as follows:

Sub test1()

''''''''''''''''''''''''''''This part states the variables and their dimenstions.
    Dim appIE As Object
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim o

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

i = 2

    Set wb = Application.Workbooks("Test2")
    Set ws = wb.Worksheets("Europcar Branches")
    Set appIE = CreateObject("internetexplorer.application")

'Navigate to Europcar
'Open internet explorer
With appIE
.Navigate "https://www.europcar.co.za"
.Visible = True
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Application.Wait (Now + TimeValue("0:00:03"))
Do While appIE.busy
    DoEvents
    Application.Wait (Now + TimeValue("0:00:05"))
    Loop
Application.Wait (Now + TimeValue("0:00:02"))

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


 Set entry = appIE.document.getElementById("PickupBranch_BranchID_id")
For Each o In entry.getElementsByName("optgroup")
Cells(i, 3).Value = o.Value
    For Each p In entry.getElementsByName("optgroup").Options
    Cells(i, 4).Value = p.innerText
   i = i + 1
Exit For
Next
Exit For

Next
'
'.Navigate "https://www.europcar.co.za"
'.Visible = True

Application.Wait (Now + TimeValue("0:00:01"))

Do While appIE.busy
    DoEvents
    Application.Wait (Now + TimeValue("0:00:03"))
    Loop

End With

appIE.quit
    Set appIE = Nothing

End Sub

A section of Html is as follows:

<select name="PickupBranch_BranchID" class="pick-up-select responsive-select" id="PickupBranch_BranchID_id" style="display: none;" data-placeholder="Pickup Location">
<option value=""></option>
<optgroup value="0" label="Airports">
<option value="10">Johannesburg OR Tambo International Airport</option>
<option value="20">Cape Town International Airport</option>
<option value="76">King Shaka International Airport</option>
<option value="48">Lanseria Airport</option>
<option value="89">Bloemfontein Airport</option>
<option value="70">East London Airport</option>
<option value="61">George Airport</option>
<option value="91">Kimberley Airport </option>
<option value="14">Polokwane Airport</option>
<option value="95">Kruger Mpumalanga Int Airport</option>
<option value="138">Malelane Airport</option>
<option value="79">Margate Airport</option>
<option value="44">CSIR Pretoria</option>
<option value="13">Pietermaritzburg Airport</option>
<option value="7">Port Elizabeth Airport</option>
<option value="84">Richards Bay Airport</option>
<option value="75">Umtata Airport</option>
<option value="103">Upington Airport</option>
<option value="52">Wonderboom Airport</option>
<option value="46">Germiston Rand Airport</option>

</optgroup>
<optgroup value="3" label="Gauteng">
<option value="133">Boksburg Easyway</option>
<option value="42">Braamfontein</option>
<option value="134">Bryanston Easyway </option>
<option value="43">Centurion</option>
<option value="135">Constantia Kloof Easyway</option>
<option value="45">Fourways</option>
<option value="154">Johannesburg Parkstation</option>
<option value="125">Kramerville</option>
<option value="121">Meadowdale</option>
<option value="50">Megawatt Park</option>
<option value="155">Menlyn Easyway</option>
<option value="47">Mogale City (Krugersdorp Agency)</option>
<option value="11">Pretoria Hatfield</option>
<option value="53">Randburg</option>
<option value="161">Rosebank Gautrain Station</option>
<option value="158">Sandton Gautrain Station</option>
<option value="55">Sandton Town</option>
<option value="59">Vanderbijlpark</option>
</optgroup>
</select>

There are many posts with vba code for scraping on here - have you looked at them? — Solar Mike
– Solar Mike, Commented Apr 26, 2019 at 11:20
@SolarMike Yes I have tried other posts but without success. My issue is that I am not proficient at VBA or HTML. I have this task to build a web scraper so that's what I am focusing on. — Hev
– Hev, Commented Apr 26, 2019 at 11:27
@QHarr , I am basically trying to get a list of all option values with its locations. 121 - Meadowdale , 55 - Sandton etc. — Hev
– Hev, Commented Apr 26, 2019 at 11:48
If I use Set entry = appIE.document.getElementById("PickupBranch_BranchID_id") Cells(i, 2).Value = entry.innerText it pulls all the locations names in one cell. I guess I need to figure out how to isolate each optgroup and then list each option value separately in two columns as I need. — Hev
– Hev, Commented Apr 26, 2019 at 11:50

QHarr · Accepted Answer · 2019-04-26 12:00:46Z

2

The following shows you how to do for one drop down (it gathers all the optgroups within). It avoids using a browser and goes with the faster xmlhttp request. I use getElementById, to get the parent select element, and then getElementsByClassName to retrieve the child option tag elements. I loop from 1 to avoid the empty first element.

References (VBE > Tools > References):

Microsoft HTML Object Library

VBA:

Option Explicit
Public Sub GetOptions()
    Dim html As Object, ws As Worksheet, headers()
    Dim i As Long, r As Long, c As Long, numRows As Long

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set html = New HTMLDocument
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://www.europcar.co.za/", False
        .send

        html.body.innerHTML = .responseText

        Dim pickupBranches As Object, pickupBranchResults()

        Set pickupBranches = html.getElementById("PickupBranch_BranchID_id").getElementsByTagName("option")
        headers = Array("Pickup Location", "option value")
        numRows = pickupBranches.Length - 1

        ReDim pickupBranchResults(1 To numRows, 1 To 2)

        For i = 1 To numRows
            pickupBranchResults(i, 1) = pickupBranches.item(i).innerText
            pickupBranchResults(i, 2) = pickupBranches.item(i).Value
        Next

        With ws
            .Cells(1, 1).Resize(1, UBound(headers) + 1) = headers
            .Cells(2, 1).Resize(UBound(pickupBranchResults, 1), UBound(pickupBranchResults, 2)) = pickupBranchResults
        End With
    End With
End Sub

edited Apr 26, 2019 at 12:00

answered Apr 26, 2019 at 11:53

QHarr

84.5k14 gold badges58 silver badges105 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

Hev Over a year ago

@QHarr.This does seem to work. Its amazing how quick this is. I will need to examine the individual lines of code as well to see how I can Incorporate this into the other part of my project. Thank you tremendously.

QHarr Over a year ago

you are welcome. It does not include the optgroups themselves i.e. Airport... but rather.. it gathers all the options values within. Easy to add those though if required.

Collectives™ on Stack Overflow

How to scrape option values from a website using VBA

1 Answer 1

2 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Related