Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Query Web da sito

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Re: Query Web da sito

Postdi Anthony47 » 13/02/18 00:40

l'unica cosa che mi manca è inserire uno stop dopo aver importato 15 tabelle. Si può fare qualcosa?
Se per "inserire uno stop" intendi "smettere di importare le altre tabelle" allora nella Sub GetWebTab2AA che usi dovresti aggiungere questa riga in questa posizione:
Codice: Seleziona tutto
        mysplit = Split(myItm.ID, "_", , vbTextCompare)
        If UBound(mysplit) > 0 Then
            jk = jk + 1: If jk > 15 Then Exit For        '<<<< AGGIUNGERE QUESTA
            mytar = "https://www.diretta.etc etc

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17664
Iscritto il: 21/03/06 16:03
Località: Ivrea

Sponsor
 

Re: Query Web da sito

Postdi Denis7 » 14/02/18 18:47

Queste le info diagnostiche:

OK 4,09 https://www.diretta.it/partita/C2zLlUn7 ... ni-partita
11 13
OK 4,09 https://www.diretta.it/partita/hxxXafe8 ... ni-partita
11 13
OK 4,09 https://www.diretta.it/partita/MJ2HDGKq ... ni-partita
11 20
OK 4,09 https://www.diretta.it/partita/pY3DI56B ... ni-partita
11 27
OK 4,09 https://www.diretta.it/partita/SfnIP1ds ... ni-partita
11 34
OK 4,09 https://www.diretta.it/partita/rVr22YbG ... ni-partita
11 41
OK 4,09 https://www.diretta.it/partita/SbMWngaT ... ni-partita
11 48
OK 4,09 https://www.diretta.it/partita/lY6JMdoO ... ni-partita
11 55
OK 4,09 https://www.diretta.it/partita/6i6vMPfD ... ni-partita
11 55
OK 4,09 https://www.diretta.it/partita/44sc9nB7 ... ni-partita
11 55
OK 4,09 https://www.diretta.it/partita/MLP6bVdk ... ni-partita
11 55
OK 4,09 https://www.diretta.it/partita/llB275OM ... ni-partita
11 62
OK 4,09 https://www.diretta.it/partita/6TuQcwks ... ni-partita
11 69
OK 4,09 https://www.diretta.it/partita/2LIPUvLf ... ni-partita
11 76
OK 4,09 https://www.diretta.it/partita/O8n5yjxA ... ni-partita
11 83


Purtroppo non riesce a copiarmi tutte le tabelle. Ho inserito l'ultima riga che mi ha detto e funziona alla perfezione, l'unico problema ora è capire perchè alcuen tabelle le "salta".

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 = 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(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
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/oklahoma-city-thunder/0fHFHEWD/risultati/"     '<<<<
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:I").ClearContents
Set myColl = IE.document.getElementById("fs-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
        jk = jk + 1: If jk > 15 Then Exit For
            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
MsgBox ("Completato...")
End Sub




Questo è il codice.


Grazie per l'aiuto.
Denis7
Utente Junior
 
Post: 13
Iscritto il: 09/02/18 17:55

Re: Query Web da sito

Postdi Anthony47 » 15/02/18 02:18

Nelle mie prove i risultati sono costanti e coerenti.
Dalle informazioni diagnostiche sembra invece che la 2°, 9°, 10° e 11° risultato non vengano scaricate.
Questo pero' e' il tipico caso in cui va fatto il debug sul posto, cioe' dovresti farlo tu sulla base di quanto hai imparato finora.

Mi viene in mente solo di provare con le seguenti modifiche, in ordine di priorita':

A) Elimina questo blocco
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


E sostituiscilo con
Codice: Seleziona tutto
            mynext = Evaluate("max(row(1:500)*(A1:I500<>""""))") + 5
            myR1 = False
reR1:
            zZz = GetTabRaim222Denis7(mytar, "parts-first horizontal", Sheets("Foglio4").Cells(mynext, 1))
            If zZz < 1 Then
                Debug.Print "NOK: ", zZz, mytar
                Debug.Print 2, myurl
                Debug.Print 3, mynext + 5, myR1
            Else
                Debug.Print "OK", zZz, mytar
                Debug.Print 11, mynext + 5, myR1
            End If
            If (Evaluate("max(row(1:500)*(A1:I500<>""""))") + 0) < (mynext + 1) And _
               myR1 = False Then
                myR1 = True
                GoTo reR1
            Else
                If myR1 = True Then Debug.Print "Post reR1", zZz, mytar, mynext, Evaluate("max(row(1:500)*(A1:I500<>""""))")
            End If


B) In aggiunta, togli all'interno della Function GetTabRaim222Denis7 la linea
myreS = ieWaitPage(IE, 1, 60) 'sessione, Stab Time, TimeOut time
e inserisci invece
Codice: Seleziona tutto
myreS = ieWaitPage(IE, 3, 60)    'sessione, Stab Time, TimeOut time


Buona fortuna!
Avatar utente
Anthony47
Moderatore
 
Post: 17664
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Query Web da sito

Postdi Denis7 » 15/02/18 16:59

Immagine


Dopo aver fatto entrambe le modifiche mi da questo errore. Come posso risolverlo?
Denis7
Utente Junior
 
Post: 13
Iscritto il: 09/02/18 17:55

Re: Query Web da sito

Postdi Anthony47 » 15/02/18 23:59

Per cominciare, nel codice e' finito erroneamente un ".Visible = False"; deve essere rigorosamente ".visible = True", cosi' se rimangono sessioni IE orfane te ne accorgi e le chiudi. Ma questo non c'entra nulla con quello che scrivi.

Mi spiace, posso solo confermare che sul mio pc il codice importa 15 blocchi di risultati, tutti al primo tentativo (le ultime modifiche fanno un secondo giro, se il primo non ha importato una tabella).
Devi quindi debuggare il problema sul tuo pc:
-quando va in errore (a proposito: che messaggio di errore?), nella finestra IE "punta la tabella coi risultati" e procedi con Esamina elemento (lo trovi tra i comandi accessibili con Tasto-Dx).
-questo ti mostrera' il codice html sottostante quella visualizzazione. Esamina se gli elementi che la macro cerca sono presenti (un elemento con ID = "fs-results"); se questo elemento contiene come prima tabella quella di nostro interesse; se questa tabella contiene dei tag <TR> il cui ID (es <tr id=g_3_bBKD8Owt etc etc) nell'ultimo spezzone (bBKD8Owt, nell'esempio) corrisponde al penultimo componente dell'url che contiene le "#informazioni-partita".

Insieme col messaggio di errore queste ispezioni potranno spiegare che cosa succede sulla tua macchina.

Sarebbe anche utile per i ragionamenti sapere se il comportamento e' fisso; se e' fisso ma alcune tabelle si importano; se e' aleatorio e in quale modo (riportare un po' di casistiche).
Comunque visto che le modifiche sono peggiorative, allora eliminale; anzi elimina la prima (quella che ha introdotto [i]mynext = Evaluate("max(row(etc etc/i] e lascia solo la seconda, quella che porta a 3 (secondi) il parametro "Stab Time" nel richiamo della funzione ieWaitPage.
Infine vorrei avere la conferma che le prove anche tu le fai sull'url https://www.diretta.it/squadra/oklahoma ... risultati/

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17664
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Query Web da sito

Postdi Denis7 » 16/02/18 16:53

Anthony47 ha scritto:Comunque visto che le modifiche sono peggiorative, allora eliminale; anzi elimina la prima (quella che ha introdotto [i]mynext = Evaluate("max(row(etc etc/i] e lascia solo la seconda, quella che porta a 3 (secondi) il parametro "Stab Time" nel richiamo della funzione ieWaitPage.


Ciao




Ho risolto lasciando le modifiche e portando il parametro stab time a 5. In questo modo mi scarica tutte le tabelle.

Ogni tanto però mi esce l'errore "run-time 91" , da cosa può essere causato?

Grazie davvero per l'aiuto.
Denis7
Utente Junior
 
Post: 13
Iscritto il: 09/02/18 17:55

Re: Query Web da sito

Postdi Anthony47 » 17/02/18 01:21

Ogni tanto però mi esce l'errore "run-time 91" , da cosa può essere causato?
Mi attribuisci capacita' divinatorie che non posseggo...
Non ti chiedo di specificare "quale riga" da' quell'errore perche' la casistica e' abbastanza varia e solo al momento in cui riesco a creare la situazione (di errore, in questo caso) potrei sperare di identificarne il perche' e il come aggirarlo.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17664
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Query Web da sito

Postdi Denis7 » 17/02/18 17:32

Anthony47 ha scritto:
Ogni tanto però mi esce l'errore "run-time 91" , da cosa può essere causato?
Mi attribuisci capacita' divinatorie che non posseggo...
Non ti chiedo di specificare "quale riga" da' quell'errore perche' la casistica e' abbastanza varia e solo al momento in cui riesco a creare la situazione (di errore, in questo caso) potrei sperare di identificarne il perche' e il come aggirarlo.

Ciao



La riga è quella evidenziata in gialla nell'immagine sopra.

queste: Set myRColl = .getElementsByTagName ("TR")

In ogni caso ho già raggiunto un risultato soddisfacente grazie al tuo aiuto:
Denis7
Utente Junior
 
Post: 13
Iscritto il: 09/02/18 17:55

Re: Query Web da sito

Postdi assodicuori82 » 28/07/18 14:34

Ciao a tutti,

ho provato i vostri suggerimenti ma penso che il sito in questione abbia delle protezioni per quello non riesco.

www.bet365.com

vorrei scaricare per la sessione calcio, prossime 24 ore, i palinsesti principali.

Considerate che non mi permette neanche di evidenzarli e copiarli a mano. Qualcuno mi aiuta? dovrei importarli in excel. Idealmente ogni volta che la faccio girare li importa in una pagina nuova, sarebbe perfetto.

Ideale se poi si riuscisse ad importare tutte le info dei singoli match presenti in un unico foglio. Idee?

grazie mille
Antonino
assodicuori82
Newbie
 
Post: 1
Iscritto il: 28/07/18 14:26

Re: Query Web da sito

Postdi Anthony47 » 29/07/18 12:16

Con quell'approccio si leggono tutte le tabelle presenti nella pagina web, ma su bet365 di tabelle non se ne vedono...

Se mi dici quale pagina vorresti prelevare, e come arrivarci dalla home (vedi immagine), vedro' se ci sono alternative valide.
Immagineimage url host

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17664
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Query Web da sito

Postdi maxrub » 09/11/19 20:30

Ciao Antony, cercavo una risposta alla stessa domanda di Antonino: scaricare i dati da bet365. Ripartendo dalla tua richiesta, vorrei scaricare da questa pagina:
https://www.bet365.it/#/IP/
non so se ci si arriva direttamente cliccando sopra, ho visto che piu pagine riportano in alto questo indirizzo, nel caso, partendo dallo screen che hai messo, bisogna cliccare sulla foto del giocatore, poi in alto scegliere "live" e poi "tennis" ci si ritrova in una schermata così:
Immagine
A me servirebbe scaricare nomi dei giocatori, punteggi e quote. Ti ringrazio
maxrub
Utente Junior
 
Post: 31
Iscritto il: 27/12/13 14:38

Re: Query Web da sito

Postdi Anthony47 » 10/11/19 14:52

Queste automazioni sono solo un gioco di tempo e di pazienza, merce rara...

Comunque, da quel che ho capito potrebbe esserti utile una macro come questa:
Codice: Seleziona tutto
'RIGOROSAMENTE IN TESTA AL MODULO:
#If VBA7 Then
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub BEToLVoLS()
Dim IE As Object, COLL1 As Object, COLL2 As Object, COLL3 As Object
Dim I As Long, J As Long, RR As Long, DSh As Worksheet
'
Set DSh = Sheets("WebData")             '<<< Il foglio su cui importare i dati
'
myurl = "https://www.bet365.it"             'L'url della pagina da accedere
If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")
myStart = Timer
With IE
    .Visible = True         '... rendi visibile IE
    .Navigate myurl         '...vai all'url
    Sleep 100
    Do While .Busy: DoEvents: Sleep (20): Loop  'Attesa not busy
    Do While .ReadyState <> 4: DoEvents: Sleep (20): Loop 'Attesa documento
End With
Sleep 500
Set COLL1 = IE.document.getElementsByClassName("ipc-InPlayClassificationIcon ipc-InPlayClassificationIcon-13")
Sleep 200
'Cerca Tennis:
COLL1(0).Click
Sleep 1000
'
Set COLL1 = IE.document.getElementsByClassName("li-InPlayLeague ")
For I = 0 To COLL1.Length - 1
    RR = RR + 2
    DSh.Cells(RR, 1) = COLL1(I).getElementsByClassName("li-InPlayLeague_Header li-InPlayLeague_Header-expanded ")(0).innerText
    RR = RR + 1
    DSh.Cells(RR, 1) = COLL1(I).getElementsByClassName("li-InPlayEventHeader_Label ")(0).innerText
    Set COLL2 = COLL1(I).getElementsByClassName("li-InPlayEventHeader_Score ")
    For J = 0 To COLL2.Length - 1
        DSh.Cells(RR, 2 + J) = "'" & COLL2(J).innerText
    Next J
    RR = RR + 1
    Set COLL2 = COLL1(I).getElementsByClassName("gll-Participant_Name")
    Set COLL3 = COLL1(I).getElementsByClassName("gll-Participant_Odds")
    For J = 0 To COLL2.Length - 1
        DSh.Cells(RR, 1 + J) = COLL2(J).innerText & " --- " & COLL3(J).innerText
    Next J
Next I
MsgBox ("Completato...")
IE.Quit
Set IE = Nothing
End Sub

Il tutto va inserito in un "Modulo standard" VUOTO del tuo vba; la riga marcata <<< va personalizzata col nome del foglio in cui si vogliono importare i dati (io ho provato con un foglio chiamato "WebData").
Poi all'occorrenza lanci la Sub BEToLVoLS; Il foglio VIENE AZZERATO SENZA PREAVVISO prima di importare i nuovi dati.

Come tutte le automazioni su pagine web, anche questa funzionera' fintanto che la struttura interna del sito non cambia; cosa che puo' avvenire stanotte, domani, la prossima settimana, il prossimo mese, o il prossimo anno, ma avverra' prima o poi.

Fai sapere...
Avatar utente
Anthony47
Moderatore
 
Post: 17664
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Query Web da sito

Postdi maxrub » 10/11/19 19:27

Ti ringrazio, ci provo e ti faccio sapere, purtroppo nella importazione di dati dall'html web ci capisco poco, ho cercato in rete ma non riesco a trovare guide per me comprensibili (dal mio basso di competenze).
maxrub
Utente Junior
 
Post: 31
Iscritto il: 27/12/13 14:38

Re: Query Web da sito

Postdi maxrub » 10/11/19 19:36

Mi da errore di rintime '91' : "variabile oggetto o variabile del blocco with non impostata" sul comando COLL1(0).Click

la variabile non viene impostata con il comando Set COLL1 = IE.document.getElementsByClassName("ipc-InPlayClassificationIcon ipc-InPlayClassificationIcon-13")?
maxrub
Utente Junior
 
Post: 31
Iscritto il: 27/12/13 14:38

Re: Query Web da sito

Postdi Anthony47 » 11/11/19 00:28

Ho modificato la macro pubblicata nel messaggio precedente proprio perche', da altre prove fatte dopo, mi compariva quell'errore; evidentemente l'ho fatto dopo che tu l'avevi copiata!
In particolare ci sono due "Sleep", una prima e una dopo l'istruzione che ti da errore.

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17664
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Query Web da sito

Postdi maxrub » 11/11/19 22:51

grazie, purtroppo però anche così mi da lo stesso errore.
maxrub
Utente Junior
 
Post: 31
Iscritto il: 27/12/13 14:38

Re: Query Web da sito

Postdi maxrub » 11/11/19 22:59

Notavo una cosa, quando parte il comando mi trovo nella pagina principale, ho visto, facendo "esamina elemento" che ipc-InPlayClassificationIcon ipc-InPlayClassificationIcon-13 riguarda il pulsante "tennis" ma in questa schermata non è presente, prima di arrivare a quella pagina devo premere sul pulsante "live" che facendo "esamina elemento" mi da:
<a class="hm-BigButton ">Live</a>
maxrub
Utente Junior
 
Post: 31
Iscritto il: 27/12/13 14:38

Re: Query Web da sito

Postdi Anthony47 » 13/11/19 02:07

Guarda, la situazione in effetti prevede molte piu' opzioni di quelle che avevo visto in prima battuta.
E, trattandosi di un gioco di tempo e di pazienza, ho esaurito tutta la pazienza della settimana per sviluppare qualcosa di funzionicchiante. Che corrisponde al seguente codice:
Codice: Seleziona tutto
'RIGOROSAMENTE IN TESTA AL MODULO:
#If VBA7 Then
    Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub BEToLVoLS2()
Dim IE As Object, COLL1 As Object, COLL2 As Object, COLL3 As Object, CollA As Object
Dim I As Long, J As Long, RR As Long, DSh As Worksheet
Dim ZNext As Long, HArr, JJ As Long, ScArr(1 To 2, 1 To 1)
Dim Teamers As String, MScorer As String, PtScore As String

'
Set DSh = Sheets("WebData")             '<<< Il foglio su cui importare i dati
'
DSh.Range("A:H").ClearContents
myurl = "https://www.bet365.it"             'L'url della pagina da accedere
If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")
myStart = Timer
With IE
    .Visible = True         '... rendi visibile IE
    .Navigate myurl         '...vai all'url
    Sleep 100
    Do While .busy: DoEvents: Sleep (20): Loop  'Attesa not busy
    Do While .readyState <> 4: DoEvents: Sleep (20): Loop 'Attesa documento
End With
Debug.Print 1, IE.busy, IE.readyState
Sleep 1000
On Error Resume Next
    'Go live:
    IE.document.getElementsByTagName("nav")(0).getElementsByTagName("a")(1).Click
    Sleep 1000
    'Go Generale
    IE.document.getElementsByClassName("ip-ControlBar_ButtonBar ")(0).getElementsByTagName("div")(0).Click
    Sleep 1000
    'Go Tennis:
    Set COLL1 = IE.document.getElementsByClassName("ipc-InPlayClassificationIcon ipc-InPlayClassificationIcon-13")
    Debug.Print "Len=" & COLL1.Length
    Sleep 200
    COLL1(0).Click
    Sleep 1000
    'Go Prospetto principale:
    nclassn = "ipo-InPlayClassificationMarketSelectorDropdownLabelContainer "
    IE.document.getElementsByClassName(nclassn)(0).getElementsByTagName("div")(0).Click
    'Go Tutti gli eventi:
    nclassn = "ipo-ClassificationHeader_EventButtonInnerWrapper "
    IE.document.getElementsByClassName(nclassn)(0).getElementsByTagName("div")(0).Click
On Error GoTo 0


'ipo-Competition ipo-Competition-open
Set CollA = IE.document.getElementsByClassName("ipo-Competition ipo-Competition-open ")

HArr = Array("ipo-CompetitionButton_NameLabel ipo-CompetitionButton_NameLabelHasMarketHeading ", _
   "ipo-CompetitionButton_MarketHeadingLabel ", "ipo-CompetitionButton_MarketHeadingLabel ", _
   "ipo-CompetitionButton_MarketHeadingLabel ")
iharr = Array(0, 0, 1, 2)

Teamers = "ipo-TeamStack_Team"
MScorer = "ipo-SetScore_SetWrapper "   '1-5!!
PtScore = "ipo-TeamPoints_TeamScoresWrapper "
'Dim HArr, JJ As Long
For I = 0 To CollA.Length - 1
    ZNext = GetLast(Range("A:H")) + 2
    If I >= CollA.Length Then Exit For
    'Legge headers:
    JJ = 0
    For J = 0 To UBound(HArr)
        JJ = JJ + 1
        Cells(ZNext, JJ).Value = CollA(I).getElementsByClassName(HArr(J))(iharr(J)).innerText
        If J = 0 Then JJ = JJ + 1
    Next J
    'Legge players:
    Set COLL1 = CollA(I).getElementsByClassName("ipo-Fixture_TableRow ")    'Match
    For k = 0 To COLL1.Length - 1
        ScArr(1, 1) = "'"
        ScArr(2, 1) = "'"
        ZNext = GetLast(Range("A:H")) + 1
        Set COLL2 = COLL1(k).getElementsByClassName(Teamers)
        For J = 0 To COLL2.Length - 1
            Cells(ZNext + J, 1) = COLL2(J).innerText
        Next J
        'Legge Risultati
        Set COLL2 = COLL1(k).getElementsByClassName(MScorer)
        For J = 0 To COLL2.Length - 1
            Set COLL3 = COLL2(J).getElementsByTagName("div")
            ScArr(1, 1) = ScArr(1, 1) & COLL3(0).innerText
            ScArr(2, 1) = ScArr(2, 1) & COLL3(1).innerText
            ScArr(1, 1) = ScArr(1, 1) & String(3 + J * 5 - Len(ScArr(1, 1)), " ") & "- "
            ScArr(2, 1) = ScArr(2, 1) & String(3 + J * 5 - Len(ScArr(2, 1)), " ") & "- "
        Next J
        'Legge Punti:
            Set COLL2 = COLL1(k).getElementsByClassName(PtScore)
            Set COLL3 = COLL2(0).getElementsByTagName("div")
            ScArr(1, 1) = ScArr(1, 1) & COLL3(0).innerText
            ScArr(2, 1) = ScArr(2, 1) & COLL3(0).innerText
        'Scrive punteggio:
            Cells(ZNext, 2) = ScArr(1, 1)
            Cells(ZNext + 1, 2) = ScArr(2, 1)
        '
        quote = "ipo-MainMarketRenderer "
        quota = "gll-ParticipantCentered_Odds"         '1+blank+1
        'Scrive Quota Winner:
            Set COLL2 = COLL1(k).getElementsByClassName(quote)
            For J = 0 To COLL2.Length - 1
            On Error Resume Next
                Set COLL3 = COLL2(J).getElementsByClassName(quota)
                Cells(ZNext, 3 + J) = COLL3(0).innerText
                Cells(ZNext + 2, 3 + J) = COLL3(1).innerText
            On Error GoTo 0
            Next J
    Next k
Next I

'Stop
    MsgBox ("Completato...")

IE.Quit
Set IE = Nothing
End Sub

Function GetLast(ByRef myRan As Range) As Long

Dim LastR As Long
On Error Resume Next
LastR = myRan.Find(What:="*", After:=myRan.Cells(1, 1), _
              SearchOrder:=xlByRows, _
              SearchDirection:=xlPrevious).Row
On Error GoTo 0
If LastR = 0 Then GetLast = 1 Else GetLast = LastR
End Function

Sostituisce integralmente il codice precedente; va messo in un Modulo standard inizialmente vuoto e poi all'occorrenza si esegue la Sub BEToLVoLS2
I risultati dei match in corso sono in colonna B; le prime "colonne" sono i risultati dei set gia' conclusi, l'ultima sono i punti del game in corso.
Buona fortuna...
Avatar utente
Anthony47
Moderatore
 
Post: 17664
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Query Web da sito

Postdi maxrub » 13/11/19 22:08

Grandeeee! funziona! Ho aggiunto solo un DSh.select che mi copiava i dati nel foglio in cui avevo messo il pulsante di avvio, ora lo provo per bene. Ti ringrazio tantissimo
maxrub
Utente Junior
 
Post: 31
Iscritto il: 27/12/13 14:38

Precedente

Torna a Applicazioni Office Windows


Topic correlati a "Query Web da sito":

Sito pc-facile
Autore: gimart
Forum: Discussioni
Risposte: 3

Chi c’è in linea

Visitano il forum: Anthony47, raimea e 40 ospiti