Проблема с вашим кодом заключается в том, что вы рассматриваете это: 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
Вот как выглядят вчерашние результаты: