EXCEL Web соскоб с "span" и "a" - PullRequest
0 голосов
/ 01 марта 2020

Я пытаюсь очистить этот сайт, где нет таблиц (поэтому нет таблицы, тд. Tr et c ..). Я должен загрузить данные из тега «a» с классом «game», где есть относительные пролеты внутри. Ниже то, что мне удалось разработать после поста о понятиях выскабливания. Заранее благодарим за вашу возможную помощь

Ошибка времени выполнения 438 в этой строке

Для каждого HTMLArow In HTMLAtab.getElementsByTagName ("a"). GetElementsByClassName ("game") *

Sub BrowseSiteElementTab()


        Dim IE As New SHDocVw.InternetExplorer
        Dim Doc As MSHTML.HTMLDocument
        Dim HTMLAtab As MSHTML.IHTMLElement
        Dim HTMLArow As MSHTML.IHTMLElement
        Dim HTMLAcel As MSHTML.IHTMLElement

        'costante con in nome della pagina web
        Const myURL As String = "https://sportalic.com/"

        'oggetto IE
        With IE
            .navigate myURL 'naviga a pagina...
            .Visible = True 'visibile ... vero
            Do While .Busy: DoEvents: Loop 'Attesa not busy
            Do While .readyState <> 4: DoEvents: Loop 'Attesa documento
        End With

        'oggetto document
        Set Doc = IE.document

     Set HTMLAtab = Doc.getElementsByTagName("div")(0)
        'ciclo per ogni riga della tabella
        For Each HTMLArow In HTMLAtab.getElementsByTagName("a").getElementsByclassName("game")
            'ciclo per ogni cella della riga
            For Each HTMLAcel In HTMLArow.getElementsByTagName("span").getElementsByclassName("tm")
                'stampa nella finestra immediata
                Debug.Print HTMLAcel.innerText
            Next HTMLAcel
        Next HTMLArow

        'Chiusura:
        IE.Quit
        Set IE = Nothing
        Set Doc = Nothing
        Set HTMLAs = Nothing

    End Sub

1 Ответ

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

Проблема с вашим кодом заключается в том, что вы рассматриваете это: HTMLAtab.getElementsByTagName("a") как один объект, когда на самом деле это набор всех якорных элементов (<a></a>) внутри HTMLAtab.

Вам это тоже не нужно Set HTMLAtab = Doc.getElementsByTagName("div")(0). Вы можете сделать это Set HTMLAtab = Doc.getElementById("games"), вместо этого.

В основном, если вы измените это HTMLAtab.getElementsByTagName("a").getElementsByClassName("game") на следующее:

doc.getElementsByClassName("game"), ваш код должен работать.

Сказав вот как я это сделаю.

Я бы не стал использовать IE. Вместо этого я бы использовал HTTP-запрос, например, так:

Option Explicit

Sub sportalic()

Dim req As New WinHttpRequest
Dim doc As New HTMLDocument
Dim anc As HTMLAnchorElement
Dim sp As HTMLSpanElement
Dim url As String
Dim d As Date

d = Date 'you can change this to whichever date you want
url = "https://sportalic.com/tips/" & Format(d, "yyyy-mm-dd")
With req
    .Open "GET", url, False
    .send
    doc.body.innerHTML = .responseText
End With
For Each anc In doc.getElementsByClassName("game")
    For Each sp In anc.getElementsByClassName("tm")
        Debug.Print sp.innerText
    Next sp
Next anc

End Sub

. В ближайшем окне будет напечатан столбец H с веб-сайта. Вы можете изменить его в соответствии с вашими потребностями.

Чтобы код работал, вам нужно добавить ссылки на:

Microsoft HTML Object Library
Microsoft WinHTTP Services version 5.1

РЕДАКТИРОВАТЬ

Сайт имхо очень плохо спроектирован, поэтому я понимаю ваше замешательство. Вот полный подход к его очистке.

Имейте в виду, что этот .getElementsByClassName("o") возвращает коллекцию всех элементов html, имя класса которых "o". Чтобы получить элемент i-th из этой коллекции, вы должны сделать это .getElementsByClassName("o")(i-1) (индексация начинается с нуля).

Option Explicit

Sub sportalic()

Dim req As New WinHttpRequest
Dim doc As New HTMLDocument
Dim anc As HTMLAnchorElement
Dim sp As HTMLSpanElement
Dim url As String, results() As String
Dim d As Date
Dim i As Long
Dim rng As Range
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("Foglio2")
Set rng = sht.Range("A2")
d = Date - 1 'you can change this to whichever date you want
url = "https://sportalic.com/tips/" & Format(d, "yyyy-mm-dd")
With req
    .Open "GET", url, False
    .send
    doc.body.innerHTML = .responseText
End With
ReDim results(1 To doc.getElementsByClassName("game").Length, 1 To 13)
i = 0
For Each anc In doc.getElementsByClassName("game")
    i = i + 1
    results(i, 1) = anc.getElementsByClassName("cn")(0).innerText
    results(i, 2) = anc.getElementsByClassName("nm")(0).innerText
    results(i, 3) = anc.getElementsByClassName("nm")(1).innerText
    results(i, 4) = anc.getElementsByClassName("t")(0).innerText
    results(i, 5) = anc.getElementsByClassName("t")(1).innerText
    results(i, 6) = anc.getElementsByClassName("t")(2).innerText
    results(i, 7) = anc.getElementsByClassName("o")(0).innerText
    results(i, 8) = anc.getElementsByClassName("o")(1).innerText
    results(i, 9) = anc.getElementsByClassName("o")(2).innerText
    results(i, 10) = anc.getElementsByClassName("tip")(0).innerText
    results(i, 11) = anc.getElementsByClassName("odd")(0).innerText
''''''check if the game has been completed (the final score is available)''''
    If Not anc.getElementsByClassName("r")(0) Is Nothing Then               '
        results(i, 12) = anc.getElementsByClassName("r")(0).innerText       '
    Else                                                                    '
        results(i, 12) = ""                                                 '
    End If                                                                  '
    If Not anc.getElementsByClassName("r")(1) Is Nothing Then               '
        results(i, 13) = anc.getElementsByClassName("r")(1).innerText       '
    Else                                                                    '
        results(i, 13) = ""                                                 '
    End If                                                                  '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Next anc
rng.Resize(UBound(results, 1), UBound(results, 2)) = results 'write the results array into a worksheet in one go

''''''''''''''Prevent numbers from being stored as text''''''''''''''''''''''
With sht                                                                    '
    Set rng = Range(rng, .Range("A" & .Rows.Count).End(xlUp).Offset(0, 13)) '
End With                                                                    '
rng.Value = rng.Value                                                       '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub

Вот как выглядят вчерашние результаты:

enter image description here

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...