Выпадающее меню HTML / VBA - PullRequest
       4

Выпадающее меню HTML / VBA

1 голос
/ 24 октября 2019

У меня небольшая проблема с рутиной VBA и HTML. Я должен выбрать из ссылки https://www.betexplorer.com/next/soccer/ раскрывающееся меню «Сортировать по:» и выбрать пункт «Лиги». Я не могу сделать это через VBA.

Это код, который я написал

Sub Scarica()
Dim IE As New SHDocVw.InternetExplorer
Dim HTMLDoc As MSHTML.HTMLDocument
Dim HTMLDoc1 As MSHTML.HTMLDocument
Dim Dropdowns As MSHTML.IHTMLElement
Dim post As MSHTML.IHTMLElement
Dim Elem As MSHTML.IHTMLElement

Application.StatusBar = "Download Elenco Campionati odierni in corso..."
Application.ScreenUpdating = False
Application.Calculation = xlManual


IE.Visible = True
IE.navigate "https://www.betexplorer.com/next/soccer/"

Do While IE.readyState <> READYSTATE_COMPLETE
Loop

'==================================================
' THIS IS THE PART THAT I CAN'T WRITE
'==================================================

Set HTMLDoc = IE.document
Set post = HTMLDoc.getElementById("wrap-header__list__item.semilong")




    Do While IE.readyState <> READYSTATE_COMPLETE
    Loop
'==================================================
'==================================================

Это мое первое сообщение, и я не могу вставить HTML-кодсайт.

Ответы [ 3 ]

1 голос
/ 24 октября 2019

Вы можете выделить правильный выпадающий элемент для выбора, комбинируя идентификатор родительского элемента select с атрибутом = значение для атрибута value соответствующего дочернего тега option. Родитель select ожидает событие onchange, которое необходимо прикрепить и отправить.

Родитель div от id и дочерний элемент option от value:

enter image description here

Обработчик событий:

enter image description here

Option Explicit
Public Sub test()
    Dim ie As InternetExplorer, evt As Object

    Set ie = New InternetExplorer

    With ie
        .Visible = True
        .Navigate2 "https://www.betexplorer.com/next/soccer/"

        While .Busy Or .readyState <> 4: DoEvents: Wend

        .document.querySelector("#nr-all [value='2']").Selected = True

        Set evt = .document.createEvent("HTMLEvents")
        evt.initEvent "change", True, False
        .document.querySelector("#nr-all select").dispatchEvent evt
        Stop                                     '< delete me later
        .Quit
    End With
End Sub
0 голосов
/ 24 октября 2019

Извините, оба кода работают, но почему, когда я пытаюсь экстраполировать название каждой лиги, они загружаются по "Kick off times", а не по лигам? Код, который я использовал:

With IE
    .Visible = True
    .navigate "https://www.betexplorer.com/next/soccer/"

    Do While .readyState <> READYSTATE_COMPLETE
    Loop

    .document.querySelector("#nr-all [value='2']").Selected = True

    Set evt = .document.createEvent("HTMLEvents")
    evt.initEvent "change", True, False
    .document.querySelector("#nr-all select").dispatchEvent evt

    Do While .readyState <> READYSTATE_COMPLETE
    Loop

    Set HTMLDoc = IE.document

End With



i = 9 'Riga di inizio copia dati
j = 0 'Colonna di inizio copia dati

Range ("A10: A1005"). ClearContents 'Pulisce la Zona dove saranno incollati i dati

Set mycoll = HTMLDoc.getElementsByTagName ("TABLE") Для каждого myItm в mycoll

    For Each trtr In myItm.Rows
        If trtr.classname = "js-tournament" Then
            inizio = InStr(trtr.innerHTML, "href=") + 6
            fine = InStr(trtr.innerHTML, "><i") - 1
            fedhtml = Trim(Mid(trtr.innerHTML, inizio, fine - inizio))
            campionato = Split(Replace(fedhtml, "/soccer/", ""), "/")
            campionato = Trim(campionato(1))
                Cells(i + 1, j + 1) = trtr.innerText
                Cells(i + 1, j + 1).Select
                Selection.RowHeight = 15
                i = i + 1
        End If
    Next trtr

Next myItm

0 голосов
/ 24 октября 2019

То, как объяснил @QHarr, просто идеально. Или вы также можете сделать что-то подобное со своим существующим кодом.

IE.Visible = True
IE.navigate "https://www.betexplorer.com/next/soccer/"

Do While IE.readyState <> READYSTATE_COMPLETE
Loop

Set HTMLDoc = IE.document
With HTMLDoc.getElementById("next-filter-sort").all(1).all(0)
    .Focus
    .Value = "2" '"Leagues"
End With
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...