Le informazioni che vuoi importare sono i risultati intermedi di ogni partita; questo dato non c'e' nella tabella principale che la query va a leggere, ma bisogna aprire una pagina diversa per ogni partita.
Per me il modo piu' lineare per ottenere il tutto e' leggere le pagine web e catturare il dato, in sostituzione della webquery che usi al momento:
Cosa che si puo' fare con una macro come questa:
- Codice: Seleziona tutto
#If VBA7 Then '!!! ON TOP OF THE VBA MODULE !!!!
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
Sub GetByAnth()
Dim IE As Object, IE2 As Object
Dim AColl As Object, BColl As Object, myTbl As Object, myBItm As Object
Dim tCol As Object
'
Set IE = CreateObject("InternetExplorer.Application")
Set IE2 = CreateObject("InternetExplorer.Application")
Range("A:G").Clear
myurl = "https://www.betexplorer.com/soccer/brazil/serie-a/results/"
IE.Visible = True
resp = GimmePage(myurl, IE)
If resp <> 0 Then Stop
Set AColl = Nothing
Set myTbl = IE.document.getElementById("js-leagueresults-all")
If myTbl Is Nothing Then GoTo TERM
On Error Resume Next
Set AColl = myTbl.getElementsByTagName("tr")
Debug.Print "AA: " & AColl.Length
'
For i = 0 To AColl.Length - 1
j = 0
For Each tCol In AColl(i).Cells
j = j + 1
Cells(i + 2, j).Value = "'" & tCol.innerText
If InStr(1, tCol.outerHTML, "href=", vbTextCompare) > 0 And j = 1 Then
ActiveSheet.Hyperlinks.Add Anchor:=Cells(i + 2, j), Address:=tCol.getElementsByTagName("a")(0).href, _
TextToDisplay:=Cells(i + 2, j).Value
Debug.Print "CC", Timer
resp = GimmePage(tCol.getElementsByTagName("a")(0).href, IE2)
If resp = 0 Then
'' IE2.Visible = True
Set myBItm = Nothing
Set myBItm = IE2.document.getElementById("js-partial")
If myBItm Is Nothing Then
Cells(i + 2, "G").Value = "?? Missing"
Else
Cells(i + 2, "G").Value = myBItm.innerText
End If
End If
Debug.Print "DD", Timer
End If
Next tCol
DoEvents
Debug.Print "EE", Timer
Next i
MsgBox ("Importate " & i - 1 & " righe")
'
TERM:
On Error Resume Next
IE.Quit
IE2.Quit
Set IE = Nothing
Set IE2 = Nothing
End Sub
Function GimmePage(ByVal LUrl As String, LIE As Object) As Long
Dim mTim As Single
With LIE
.navigate LUrl
mytim = Timer
Sleep 100
Do
Sleep 30
If .busy = False And .readyState = 4 Then Exit Do
If Timer > (mytim + 10) Then
If .readyState <> 4 Then GimmePage = 10
If .busy Then WaitPage = GimmePage + 1
Exit Do
End If
DoEvents
Loop
End With
End Function
Il codice va messo in un modulo standard inizialmente vuoto, in modo che le Declare iniziali si trovino prima di ogni Sub.
Poi si seleziona il foglio su cui saranno scritti i risultati e va lanciata la Sub GetByAnth;
ATTENZIONE: le colonne A:G del foglio vengono azzerate senza preavviso. Ovviamente aprire in sequenza 140 pagine web richiedera' il suo tempo, quindi armati di pazienza.
Ciao