Query Web da sito

[mmrrcc]

Ciao a tutti! Mi sembra che questa sia la sezione più adatta per chiedere aiuto riguardo al mio problema. Io dovrei scaricarmi, almeno ogni giorno, i palinsesti di vari siti di scommesse contenuti qui: http://betcalcio.it/home/home.asp?sid={03CCF81A-FBF6-4B3C-8906-FA4D7B97FCDA}&idca=32&idpa=2. Lo potrei fare dal menu dati di excel, inserisco il link che mi serve (es. http://www.betcalcio.it/home/home.asp?s ... ATCHPOINT) e sono apposto. solo che quando cambiano i palinsesti cambia anche il link e excel non trova più le tabelle così non riesce ad aggiornarle! c'è una qualche macro che riesce a aggiornarli ogni volta che clicco un pulsante senza preoccuparmi del fatto che i link variano?

[mmrrcc]

ah dimenticavo! importando la tabella basta che parta dalla cella a1 non mi servono formattazioni particolari o quant'altro

[Anthony47]

Ciao mmrrcc, benvenuto nel forum.
Per esaminare la possibilita' di scaricare da un sito web bisogna guardare il sorgente html, cioe' aver l' url reale; quelli pubblicati contengono un SID che non dovrebbe esserci.

Ciao

[mmrrcc]

Quindi si può fare qualcosa? perdonami l'ignoranza ma ne so quanto prima:)

[Anthony47]

Con altre parole: se mi dici quali sono gli url da cui vorresti attingere potro' valutare la fattibilita'.

Ti consiglio anche di leggere cosa sto' per scrivere ad altro utente in questa discussione: viewtopic.php?f=26&t=104420

Ciao

[mmrrcc]

Allora: premesso che non so quale sia l'url reale e quindi non so nemmeno se sia giusto questo http://www.betcalcio.it/home/home.asp?s ... ILLIAMHILL , io la tabella dovrei scaricarla da qui! Probabilmente però quando aprirai il link non ci sarà alcuna tabella proprio perchè nell'aggiornamento dei palinsesti cambia anche il link. Tuttavia il sito è betcalcio.it e sotto la scheda "tutti i palinsesti" nel menu sulla sinistra ci sono tutti i nomi dei bookmaker; cliccandoci sopra esce il palinsesto aggiornato (http://betcalcio.it/home/home.asp?sid={03CCF81A-FBF6-4B3C-8906-FA4D7B97FCDA}&idca=32&idpa=2). Ecco io dovrei mettere in 16 fogli diversi 16 di quei palinsesti, uno per foglio. Basta sapere come si fa con uno solo comunque, poi mi arrangio

[Anthony47]

E' il Session Id che cambia a ogni connessione.
Quindi dobbiamo fare un primo giro, dalla pagina http://www.betcalcio.it/home/home.asp per farci assegnare un sid e poi lo usiamo nel calcolo dell' url delle pagine da importare.

Il tutto e' gestito dalla Sub BetCalcio() e la subordinata Sub GetWebTab(ByVal myUrl As String), come fatto nel file demo allegato, scaricabile qui: https://www.dropbox.com/s/1rsttml3uyan2 ... .xlsm?dl=0

La macro assume che ogni bookmaker abbia nel file un foglio chiamato "Tabelle_BOOKMAKER", dove la componente "Tabelle_" e' obbligatorio mentre la componente "BOOKMAKER" puo' essere definito a piacere perche' va poi inserito in una tabella presente nella macro.
In realta' ci sono 2 tabelle da compilare (io le ho compilate con i valori dei primi 4 bookmakers-BM):

Codice: Seleziona tutto

tablId = Array(1, 2, 4, 5)                                  '<<Completare
tablSh = Array("SNAI", "BetClick", "MatchPoint", "TotoSi")  '<<< Completare


Gli Id della prima tabella sono quelli usati sul sito per puntare alle pagine dei vari BM; per leggerli, dalla pagina "Tutti i palinsesti", basta passare il mouse sul link e guardare quale "idb" viene puntato (es &idb=2 per BetClick). Le due tabelle vanno compilate con i vari Idb e la seconda componente del nome foglio per quel BM.
I nomi fogli devono esistere, altrimenti la Sub BetCalcio() andra' in errore; inoltre ogni foglio viene AZZERATO SENZA PREAVVISO quando si lancia la Sub BetCalcio(), e tutte le tabelle presenti su quella pagina verranno importate sul foglio.
La macro non fa nessuna formattazione delle tabelle; puo' essere aggiunta usando una macro autoregistrata.

Spero che quanto fatto sia di qualche utilita'

Ciao

[mmrrcc]

Perfetto grazie mille!! Dopo lo provo ma da quello che ho capito dovrebbe essere ciò che cercavo:)
Ora, io avrei già pronte le macro che filtrano i dati per quel che serve a me, solo che avendolo scritte io penso che siano un po' macchinose e per questo ci impiega anche abbastanza ad eseguire. Sostanzialmente io dovrei isolare in un elenco a parte (su un altro foglio) le partite comuni a 3 palinsesti (tutti i palinsesti invece sono di un altro file excel, ad importarli nel file che voglio io ce la faccio da solo). C'è una macro che riesce a farlo?

[Denis7]

Ciao, ho usato la macro iniziale per importare le tabelle da una pagina web e fin lì tutto ok.

Vorrei però fare delle modifiche.

Dove devo modificare il codice per importare solo la tabella 3? (vedi foto)




Inoltre è possibile farlo per più link contemporaneamente?


Grazie per l'aiuto

[Anthony47]

ho usato la macro iniziale per importare le tabelle da una pagina web e fin lì tutto ok

La macro iniziale e' fatta apposta per importare una specifica tabella (la 5°); se tu importi tutte le tabelle allora utilizzi un'altra delle macro pubblicate nella discussione.
Vedi se con quanto scritto nella "macro iniziale" (viewtopic.php?f=26&t=100441#p579926) riesci ad adattare da solo; altrimenti pubblica il codice della macro usata, compreso l'url da esaminare.

Quanto a "contemporaneamente" il concetto e' vago; ma certamente si puo' fare prima un link e subito dopo un secondo.

Ciao

[Denis7]

Codice: Seleziona tutto

Sub GetWebTab2()
Dim IE As Object, F As Long
Dim myRColl, myDColl, KK As Long, I As Long, J As Long, myColl, myR, myTD
'
myURL = "https://www.diretta.it/partita/KM0uLUiT/#informazioni-partita"     '<<<<
Set IE = CreateObject("InternetExplorer.Application")
'
With IE
    .navigate myURL
    .Visible = False
    Do While .Busy: DoEvents: Loop              'Attesa not busy
    Do While .readyState <> 4: DoEvents: Loop   'Attesa documento
End With
'
myStart = Timer                                 'attesa addizionale
Do
    DoEvents
    If Timer > myStart + 2 Or Timer < myStart Then Exit Do
Loop

'Leggi le tabelle su foglio5 (su un nuovo foglio)
'Worksheets.Add                                              '<<<<<1  -Nuovo foglio
Application.Goto (Sheets("Foglio2").Range("A1"))            '<<<<<2  -Foglio esistente
Cells.Clear
Set myColl = IE.Document.getElementsbyTagName("TABLE")
For Each myItm In myColl
    Cells(I + 1, "A").Value = "TABELLA_" & KK: KK = KK + 1: I = I + 1
    For Each trtr In myItm.Rows
        For Each tdtd In trtr.Cells
            Cells(I + 1, J + 1) = tdtd.innertext
            J = J + 1
        Next tdtd
        I = I + 1: J = 0
    Next trtr
I = I + 2
Next myItm
'Legge le tabelle dentro gli iframe:
Set myColl = IE.Document.getElementsbyTagName("iframe")
For F = 0 To myColl.Length - 1
If Left(myColl(F).ID, 7) = "myframe" Then
Set my2coll = myColl(F).contentDocument.getElementsbyTagName("table")
    For Each myItm In my2coll
    Cells(I + 1, "A").Value = "TABELLA_" & KK: KK = KK + 1: I = I + 1
        Set myRColl = myItm.getElementsbyTagName("tr")
        For Each myR In myRColl
            Set myDColl = myR.getElementsbyTagName("td")
            For Each myTD In myDColl
                Cells(I + 1, J + 1) = myTD.innertext
                J = J + 1
            Next myTD
            I = I + 1: J = 0
        Next myR
    I = I + 2
    Next myItm
End If
Next F
'
    Cells.WrapText = False
    Range("A1").Select
'
'Stop     'Vedi testo
'
'Chiusura IE
IE.Quit
Set IE = Nothing
End Sub

Allora il codice è questo.

https://www.diretta.it/squadra/los-ange ... /ngegZ8bg/ poi da questo link vorrei estrarre tutte le "tabelle 3" delle ultime 10 partite. Si può impostare una macro che entra in ogni partita ed estrae la tabella?

Grazie per l'aiuto e se riesci (e hai tempo) spiegami il motivo delle modifiche del codice perchè sto cercando di imparare.

Grazie ancora.

[Anthony47]

Se vuoi importare una sola tabella allora potresti meglio utilizzare la Function GetTabRaim222 presentata qui: viewtopic.php?p=612404#p612528

Dopo aver inserito in un "modulo standard" del vba tutto il codice pubblicato in quel messaggio devi richiamare la funzione passandogli l'Url, il numero della tabella, il range in cui il risultato va creato.

Ad esempio:

Codice: Seleziona tutto

Sub prendiTab()
zzz = GetTabRaim222("https://www.diretta.it/partita/KM0uLUiT/#informazioni-partita", 4, Sheets("Foglio4").Range("G4"))
If zzz <> 1 Then
    MsgBox ("Operazione non riuscita")
Else
    MsgBox ("Tabella importata")
End If
End Sub

Questa va sul sito, preleva la "tabella N° 4, ne posiziona il contenuto in Foglio4!G4
Nota che il numero di tabella e' determinato dalla struttura della pagina web, potrebbe non essere in evidente rapporto con le tabelle viauslizzate; quindi probabilmente lo determinerai per tentativi. Oppure prima esegui la Sub GetWebTab2 che le importa e le enumera tutte.

Come detto nel messaggio linkato, la GetTabRaim222 restituisce 1 se tutto ok, oppure 0 se c'e' stato qualche errore; l'esito viene controllato dall' If zzz <> 1 Then e relativi messaggi.

ATTENZIONE che la GetTabRaim222 azzera un'area di 100 righe per 20 colonne a partire dall'area in cui la tabella va importata. Quindi se pensi di mettere piu' tabelle nelle stesse colonne devi partire da quelle posizionate nelle prime righe, per inserire poi le tabelle nelle righe successive.

Quanto al voler estrarre una certa tabella "delle ultime 10 pertite", per puro scopo ludico ho realizzato questa macro che legge gli indirizzi delle ultime 10 partite e poi usa la GetTabRaim222 per estrarre una singola tabella (ho immaginato fosse la 4) accodando queste tabelle in Foglio4

Codice: Seleziona tutto

Sub GetWebTab2AA()
Dim IE As Object, F As Long
Dim myRColl, myDColl, KK As Long, I As Long, J As Long, myColl, myR, myTD
'
myUrl = "https://www.diretta.it/squadra/los-angeles-lakers/ngegZ8bg/"     '<<<<
Set IE = CreateObject("InternetExplorer.Application")
'
With IE
    .navigate myUrl
    .Visible = True   'False
    Do While .Busy: DoEvents: Loop              'Attesa not busy
    Do While .readyState <> 4: DoEvents: Loop   'Attesa documento
End With
'
myStart = Timer                                 'attesa addizionale
Do
    DoEvents
    If Timer > myStart + 2 Or Timer < myStart Then Exit Do
Loop

Sheets("Foglio4").Range("A:Z").ClearContents
Set myColl = IE.document.getElementById("fs-summary-results")
With myColl.getElementsByTagName("Table")(0)
    Set myRColl = .getElementsByTagName("TR")
    For Each myItm In myRColl
        mysplit = Split(myItm.ID, "_", , vbTextCompare)
        If UBound(mysplit) > 0 Then
            mytar = "https://www.diretta.it/partita/" & mysplit(UBound(mysplit)) & "/#informazioni-partita"
            zzz = GetTabRaim222(mytar, 4, Sheets("Foglio4").Cells(Rows.Count, 1).End(xlUp).Offset(5, 0))
            If zzz <> 1 Then Stop
        End If
    Next myItm
End With
IE.Quit
Set IE = Nothing
MsgBox ("Completato...")
End Sub

Va messa in un Modulo standard del vba (in aggiunta al codice della Function GetTabRaim222); poi va lanciata.
ATTENZIONE: azzera senza preavviso le colonne A:Z di Foglio4.

Fanne buon uso.

[Denis7]

Fantastico. Ho seguito le tue istruzioni ed è tutto ok.

Con l'ultima macro però (quella che importa le ultime 10 partite) ho qualche problema. Mi importa soltanto sette partite e ogni tanto ne salta qualcuna. Posso apportare qualche modifica al codice per risolvere questo problema?

[Anthony47]

Il codice e' liberamente usufruibile; meglio se poi pubblichi il codice corretto.

Ciao

[Denis7]

Ho provato con delle modifiche, ma non sono riuscito. Ora ho impostato il codice iniziale da te scritto, ma ho questo errore (vedi immagine).

Codice: Seleziona tutto

Function GetTabRaim222(ByVal uurrll As String, ByVal ttAAbb As Long, myDest As Range) As Variant
Dim BetFlag As Boolean, myColl, my2Coll, IE As Object, LnkCnt As Long
Dim myRetr As Long, I0 As Long, I As Long, myLink As Object
'
myUrl = urll '"https://www.diretta.it/squadra/orlando-magic/QZMS36Dn/"
Set IE = CreateObject("InternetExplorer.Application")
'
Refr:
With IE
'Debug.Print "---------"
    .navigate myUrl
    .Visible = False
End With
'wait for page...
myreS = ieWaitPage(IE, 1, 60)    'sessione, Stab Time, TimeOut time
If myreS <> 0 Then
    If myRetr < 5 Then
        myRetr = myRetr + 1
        GoTo Refr
    Else
        Rispo = MsgBox("3 errori sulla pagina; recuperare manualmente e poi:" _
            & vbCrLf & "-premere OK se recuperato" _
            & vbCrLf & "-premere CANCEL se non recuperabile e quindi Abort della raccolta", vbOKCancel)
        If Rispo <> vbOK Then GoTo AbortA
    End If
End If
myRetr = 0
'
'Leggi le tabelle
myDest.Cells(1, 1).Resize(100, 20).ClearContents

'Stop
DoEvents
''I = 5
Set myColl = IE.document.getElementsByTagName("TABLE")
''Set my2Coll = IE.document.getElementsByTagName("A")
If myColl.Length >= ttAAbb Then                    'Vedi "Edit" in fondo
    Set myItm = myColl(ttAAbb - 1)
Else
    GoTo AbortA
End If
For Each trtr In myItm.Rows
    For Each tdtd In trtr.Cells
        myDest.Cells(1, 1).Offset(KK, jj) = tdtd.innertext
        jj = jj + 1
    Next tdtd
    KK = KK + 1: jj = 0
Next trtr
GetTabRaim222 = 1           '1=Ok
'
''Stop     'Vedi testo
'
fineA:
'Chiusura IE
IE.Quit
Set IE = Nothing
Set myColl = Nothing
Exit Function
'
AbortA:
    GetTabRaim222 = 0       '0=Abort
    GoTo fineA
End Function

Sub myWait(ByVal myStab As Single)
Dim myStTim As Single
'
    myStTim = Timer
    Do          'wait myStab
        DoEvents
        If Timer > myStTim + myStab Or Timer < myStTim Then Exit Do
    Loop
End Sub


Function ieWaitPage(ByRef iEs As Object, ByVal myStab As Long, ByVal myTO As Long) As Long
'0=ok; 1=timeout su .Busy; 2=timeout su .ReadyState; 4=Altro errore
'
Dim myStTim As Single, FlErr As Long
'
On Error GoTo FatErr
myStTim = Timer
Call myWait(0.2)      'wait iniziale
'
With iEs
    Do While .Busy: DoEvents:
        If Timer > myStTim + myTO Or Timer < myTO Then FlErr = 1: Exit Do
        Loop    'Attesa not busy
    Do While .readyState <> 4: DoEvents
        If FlErr <> 0 Then Exit Do
        If Timer > myStTim + myTO Or Timer < myTO Then FlErr = FlErr + 2: Exit Do
        Loop 'Attesa documento
End With
If FlErr = 0 Then
aazzz = myStab

    Call myWait(myStab)
End If
    ieWaitPage = FlErr
Exit Function
FatErr:
    ieWaitPage = FlErr + 4
End Function

    Sub GetWebTab2AA()
    Dim IE As Object, F As Long
    Dim myRColl, myDColl, KK As Long, I As Long, J As Long, myColl, myR, myTD
    '
    myUrl = "https://www.diretta.it/squadra/orlando-magic/QZMS36Dn/"     '<<<<
    Set IE = CreateObject("InternetExplorer.Application")
    '
    With IE
        .navigate myUrl
        .Visible = False
        Do While .Busy: DoEvents: Loop              'Attesa not busy
        Do While .readyState <> 4: DoEvents: Loop   'Attesa documento
    End With
    '
    myStart = Timer                                 'attesa addizionale
    Do
        DoEvents
        If Timer > myStart + 2 Or Timer < myStart Then Exit Do
    Loop

    Sheets("Foglio4").Range("A:Z").ClearContents
    Set myColl = IE.document.getElementById("fs-summary-results")
    With myColl.getElementsByTagName("Table")(0)
        Set myRColl = .getElementsByTagName("TR")
        For Each myItm In myRColl
            mysplit = Split(myItm.ID, "_", , vbTextCompare)
            If UBound(mysplit) > 0 Then
                mytar = "https://www.diretta.it/partita/" & mysplit(UBound(mysplit)) & "/#informazioni-partita"
                zzz = GetTabRaim222(mytar, 4, Sheets("Foglio4").Cells(Rows.Count, 1).End(xlUp).Offset(5, 0))
                If zzz <> 1 Then Stop
            End If
        Next myItm
    End With
    IE.Quit
    Set IE = Nothing
    MsgBox ("Aggiornamento completato")
    End Sub

Il codice è questo. Ho provato a modificare l'url iniziale, ma non funziona ugualmente e quindi l'ho tolto di nuovo.

[Anthony47]

Ho rieseguito senza problemi la Sub GetWebTab2AA, importando su Foglio4 10 tabelline con i risultati dei Los Angeles Lakers.
Facciamo cosi': al posto dell'istruzione If zzz <> 1 Then Stop inserisci questo blocco:

Codice: Seleziona tutto

            If zZz <> 1 Then
                Debug.Print "NOK: ", zZz, mytar
                Debug.Print 2, myurl
                Debug.Print 3, Sheets("Foglio4").Cells(Rows.Count, 1).End(xlUp).Offset(5, 0).Row
            Else
                Debug.Print "OK", zZz, mytar
                Debug.Print 11, Sheets("Foglio4").Cells(Rows.Count, 1).End(xlUp).Offset(5, 0).Row
            End If

Poi quando la Sub GetWebTab2AA si completa, controlla in Foglio4 per vedere quanti blocchi sono stati importati.
Infine vai nel vba, premi Contr-g per aprire la "finestra Immediata", copi tutto quello che c'e' scritto dentro e lo incolli nel tuo prossimo messaggio

Ciao

[Denis7]

Ciao, solo tre tabelle copiate.

Questo è quello che mi esce con ctrl-g:

OK
11 6
NOK: 1 https://www.diretta.it/partita/MJ2HDGKq ... ni-partita
2 https://www.diretta.it/squadra/los-ange ... /ngegZ8bg/
3 6
NOK: 1 https://www.diretta.it/partita/OO2HHPLH ... ni-partita
2 https://www.diretta.it/squadra/los-ange ... /ngegZ8bg/
3 6
NOK: 1 https://www.diretta.it/partita/SfnIP1ds ... ni-partita
2 https://www.diretta.it/squadra/los-ange ... /ngegZ8bg/
3 13
NOK: 1 https://www.diretta.it/partita/xY72sXMj ... ni-partita
2 https://www.diretta.it/squadra/los-ange ... /ngegZ8bg/
3 13
NOK: 1 https://www.diretta.it/partita/Svfoyd0H ... ni-partita
2 https://www.diretta.it/squadra/los-ange ... /ngegZ8bg/
3 20
NOK: 1 https://www.diretta.it/partita/YX09d3Sf ... ni-partita
2 https://www.diretta.it/squadra/los-ange ... /ngegZ8bg/
3 20
NOK: 1 https://www.diretta.it/partita/b3bEHA3R ... ni-partita
2 https://www.diretta.it/squadra/los-ange ... /ngegZ8bg/
3 20
NOK: 1 https://www.diretta.it/partita/YLnZ1qnp ... ni-partita
2 https://www.diretta.it/squadra/los-ange ... /ngegZ8bg/
3 20
NOK: 1 https://www.diretta.it/partita/bN43BdJt ... ni-partita
2 https://www.diretta.it/squadra/los-ange ... /ngegZ8bg/
3 20
NOK: 1 https://www.diretta.it/partita/nqag3aRJ ... ni-partita
2 https://www.diretta.it/squadra/los-ange ... /ngegZ8bg/
3 27

[Denis7]

Ho provato modificando l'url nel codice (https://www.diretta.it/squadra/los-ange ... isultati/) e di conseguenza anche questa parte:

Codice: Seleziona tutto

 Set myColl = IE.document.getElementById("fs-results")

Tutto ok, la macro vorrebbe importare tutte le oltre 40 tabelle, ma ne importa soltanto 22 e inoltre in alcuni casi importa la tabella numero 5 e non la 4. Potrebbe essere un problema della mia versione di IE?

Inoltre con questa variazione del codice posso impostare un numero massimo di tabelle da estrarre?

Grazie e buona domenica.

[Anthony47]

Il mio suggerimento avrebbe dovuto essere:
al posto dell'istruzione If zzz <> 1 Then Stop
inserisci questo blocco:

Codice: Seleziona tutto

            If zZz <> 1 Then
                Debug.Print "NOK: ", zZz, mytar
                Debug.Print 2, myurl
                Debug.Print 3, Sheets("Foglio4").Cells(Rows.Count, 1).End(xlUp).Offset(5, 0).Row
            Else
                Debug.Print "OK", zZz, mytar
                Debug.Print 11, Sheets("Foglio4").Cells(Rows.Count, 1).End(xlUp).Offset(5, 0).Row
            End If

E' possibile che tu abbia interpretato in modo diverso il mio messaggio precedente, confuso come e' stato nella formattazione (ora pero' gia' corretta).
Infatti tutti quegli "1" dopo i vari NOK indicano esiti corretti (e' il valore di zZz); quindi quelle stampe non dovrebbero esserci (visto che zZz e' 1).
Ma e' anche evidente dalla riga 3 xx che solo 3 tabelle sono state importate: la 4°, 6° e 11° (molto piu' probabilmente la 3°, 5° e 10°; mi confonde il primo Ok /11 /6, che non quadra).

Purtroppo molte cose dipendono da IE e dai suoi settaggi; per assurdo la presenza di un "anti pubblicità" potrebbe ridurre il numero di tabelle presenti sulla pagina. Io uso IE 11

Il codice chiave e' quello della Function GetTabRaim222, che e' gia' abbastanza "robusto" (gestisce errori e fa retry per superarli); l'unica cosa che mi vien da suggerire e' di modificare all'interno della Function ieWaitPage (usata da GetTabRaim222) la riga Call myWait(0.2) in

Codice: Seleziona tutto

Call myWait(0.5)      'wait iniziale

Un intervento piu' radicale potrebbe prevedere l'uso di una function derivata dalla GetTabRaim222, ma specifica per questo tipo di estrazione.
L'ho chiamata Function GetTabRaim222Denis7 e corrisponde al seguente codice:

Codice: Seleziona tutto

Function GetTabRaim222Denis7(ByVal uurrll As String, ByVal ttAAbb As String, myDest As Range) As Variant
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=100441&p=642086#p642086
'Variante della Function GetTabRaim222
'Usa Classname per identificare la tabella da importare
'
'restituisce: N°TabellaImportata + TotTabellePresenti/100, se esito regolare
'             0, se esito irregolare
Dim BetFlag As Boolean, myColl, my2Coll, IE As Object, LnkCnt As Long
Dim myRetr As Long, I0 As Long, I As Long, myLink As Object
'
myurl = uurrll  '
Set IE = CreateObject("InternetExplorer.Application")
'
Refr:
With IE
'Debug.Print "---------"
    .navigate myurl
    .Visible = True
End With
'wait for page...
myreS = ieWaitPage(IE, 1, 60)    'sessione, Stab Time, TimeOut time
If myreS <> 0 Then
    If myRetr < 5 Then
        myRetr = myRetr + 1
        GoTo Refr
    Else
        Rispo = MsgBox("3 errori sulla pagina; recuperare manualmente e poi:" _
            & vbCrLf & "-premere OK se recuperato" _
            & vbCrLf & "-premere CANCEL se non recuperabile e quindi Abort della raccolta", vbOKCancel)
        If Rispo <> vbOK Then GoTo AbortA
    End If
End If
myRetr = 0
'
'Leggi le tabelle
myDest.Cells(1, 1).Resize(500, 20).ClearContents

'Stop
DoEvents
''I = 5
Set myColl = IE.document.getElementsByTagName("TABLE")
''Set my2Coll = IE.document.getElementsByTagName("A")
If myColl.Length = 0 Then                   'Vedi "Edit" in fondo
    GoTo AbortA
End If

'    Set myItm = myColl(ttAAbb - 1)

For Each myItm In myColl
I = I + 1
    If myItm.className = ttAAbb Then
        For Each trtr In myItm.Rows
            For Each tdtd In trtr.Cells
                myDest.Cells(1, 1).Offset(KK, jj) = tdtd.innerText
                jj = jj + 1
            Next tdtd
            KK = KK + 1: jj = 0
        Next trtr
        Exit For
    End If
Next myItm
GetTabRaim222Denis7 = I + myColl.Length / 100       '>1=Ok
'
'Stop     'Vedi testo
'
fineA:
'Chiusura IE
IE.Quit
Set IE = Nothing
Set myColl = Nothing
Exit Function
'
AbortA:
    GetTabRaim222Denis7 = 0       '0=Abort
    GoTo fineA
End Function

La puoi aggiungere alle macro attuali, ad esempio in un nuovo Modulo standard del vba.

Poi userai questa variante della Sub GetWebTab2AA per richiamarla:

Codice: Seleziona tutto

Sub GetWebTab2AAB()
'prove dep Denis7
Dim IE As Object, F As Long
Dim myRColl, myDColl, KK As Long, I As Long, J As Long, myColl, myR, myTD
'
myurl = "https://www.diretta.it/squadra/los-angeles-lakers/ngegZ8bg/"     '<<<<
Set IE = CreateObject("InternetExplorer.Application")
'
With IE
    .navigate myurl
    .Visible = True   'False
    Do While .busy: DoEvents: Loop              'Attesa not busy
    Do While .readystate <> 4: DoEvents: Loop   'Attesa documento
End With
'
myStart = Timer                                 'attesa addizionale
Do
    DoEvents
    If Timer > myStart + 2 Or Timer < myStart Then Exit Do
Loop

Sheets("Foglio4").Range("A:I").ClearContents
Set myColl = IE.document.getElementById("fs-summary-results")
With myColl.getElementsByTagName("Table")(0)
    Set myRColl = .getElementsByTagName("TR")
    For Each myItm In myRColl
        mysplit = Split(myItm.ID, "_", , vbTextCompare)
        If UBound(mysplit) > 0 Then
            mytar = "https://www.diretta.it/partita/" & mysplit(UBound(mysplit)) & "/#informazioni-partita"
'            zZz = GetTabRaim222(mytar, 4, Sheets("Foglio4").Cells(Rows.Count, 1).End(xlUp).Offset(5, 0))
            zZz = GetTabRaim222Denis7(mytar, "parts-first horizontal", Sheets("Foglio4").Cells(Rows.Count, 1).End(xlUp).Offset(5, 0))
            If zZz < 1 Then
                Debug.Print "NOK: ", zZz, mytar
                Debug.Print 2, myurl
                Debug.Print 3, Sheets("Foglio4").Cells(Rows.Count, 1).End(xlUp).Offset(5, 0).Row
            Else
                Debug.Print "OK", zZz, mytar
                Debug.Print 11, Sheets("Foglio4").Cells(Rows.Count, 1).End(xlUp).Offset(5, 0).Row
            End If
        End If
    Next myItm
End With
IE.Quit
Set IE = Nothing

End Sub

Ho lasciato i "debug.print", in modo da avere un tot di info diagnostiche, se siamo ancora in panne

Ciao

[Denis7]

Grazie davvero. Quasi risolto. Solo che spesso l'ultima partita giocata non me la importa, per ovviare a questo problema andrei a prendere i risultati da qui es: https://www.diretta.it/squadra/oklahoma ... risultati/ .

Ho fatto tutte le modifiche al codice (fs-summary-results diventa semplicemente fs-results), l'unica cosa che mi manca è inserire uno stop dopo aver importato 15 tabelle. Si può fare qualcosa?


grazie ancora.