Как очистить значения параметров с веб-сайта, используя VBA - PullRequest
0 голосов
/ 26 апреля 2019

Я пытаюсь получить названия и значения местоположений со страницы веб-сайта. Например: я хочу взять значение 10 и пометить «Международный аэропорт Йоханнесбург ИЛИ Тамбо» и вставить его в ячейки B3 и B4 соответственно, а затем зациклить его для всех оптгрупп. Я получаю сообщение об ошибке «Объект не поддерживает это свойство или метод». Я уверен, что мой код имеет несколько проблем. Любая помощь будет принята с благодарностью. Мой код выглядит следующим образом:

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

Раздел Html выглядит следующим образом:

<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>

1 Ответ

2 голосов
/ 26 апреля 2019

Ниже показано, как сделать один выпадающий список (в нем собраны все optgroup с). Он избегает использования браузера и работает с более быстрым запросом xmlhttp. Я использую getElementById, чтобы получить родительский элемент select, а затем getElementsByClassName, чтобы получить дочерние элементы тега option. Я зацикливаюсь с 1, чтобы избежать пустого первого элемента.


Ссылки (VBE> Инструменты> Ссылки):

  1. Библиотека объектов Microsoft HTML

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...