Estrarre dati da futbol24

[ilfuocoblu]

Buongiorno a tutti, ho bisogno del vostro aiuto.
Ho cercato di estrarre i dati dalla pagina web https://www.futbol24.com/Live/ adattando anche le varie macro postate per altri siti, ma non riesco. La tabella che mi interessa non viene scaricata che è quella centrale, ovvero nazione, minutaggio, squadre e risultato in corso.
Come potrei riuscire?
Grazie per gli eventuali aiuti!

[Anthony47]

Mi pare che puoi usare Chrome oppure Edge avendo installato sul tuo Pc l'ambiente Selenium; vedi viewtopic.php?f=26&t=112225
Poi prova a dare un'occhiata a quanto descritto qui: viewtopic.php?f=26&t=113463#p667607
Ad esempio puoi usare la Sub GetAllTablesArr, descritta e utilizzata qui: viewtopic.php?f=26&t=112311#p660074
A quel punto potrai importare sul foglio selezionato tutte le "Tabelle" che sono presenti in una pagina web.

Il codice complessivo, da inserire su un Modulo standard INIZIALMENTE VUOTO del tuo vba

Codice: Seleziona tutto

Dim WPage As Object

Sub PrintTables()
Dim myUrl As String
'
'Crea Driver:
If WPage Is Nothing Then
    Set WPage = CreateObject("Selenium.EdgeDriver")
End If
WPage.Start "edge"                       'Avvia EDGE
'
Sheets("AllTables").Select               'Il Foglio che vuoi tu
Range("A:M").ClearContents               'Azzera l'area di input
'
myUrl = "https://www.futbol24.com/Live/"
Call GetAllTablesArr(myUrl)         'Posiziona in colonna A
'
'Quit Selenium
WPage.Quit
Set WPage = Nothing
MsgBox ("Informazioni raccolte...")
End Sub


Sub GetAllTablesArr(myUrl As String, Optional rNum0 As Long = 1, Optional cNum0 As Long = 1)
Dim TBColl As Object
Dim I As Long, J As Long, myTim As Single
Dim RNum As Long, CNum As Long
   
Dim TArr

If WPage Is Nothing Then
    Set WPage = CreateObject("Selenium.EdgeDriver")
End If
WPage.Get myUrl
'
myTim = Timer
'
Set TBColl = WPage.FindElementsByTag("table")
RNum = rNum0: CNum = cNum0
'
For I = 1 To TBColl.Count               'Scan delle Tabelle presenti
    TArr = TBColl(I).AsTable.Data
    RNum = RNum + 1
    Cells(RNum, CNum).Value = "## Table " & I
    If (UBound(TArr) * UBound(TArr, 2)) > 0 Then
        Cells(RNum + 1, CNum).Resize(UBound(TArr), UBound(TArr, 2)).Value = TArr
    End If
    RNum = RNum + UBound(TArr) + 1
    DoEvents
Next I
Debug.Print "FINE", RNum, Format(Timer - myTim, "0.00"), myUrl
End Sub


(questo usa Edge)

Prova...