Come per tanti altri casi non ti ho abbandonato, ma sono stato in una situazione "migratoria" che mi ha tenuto abbastanza lontano dal pc.
In questo caso bisogna creare una diversa Sub GetWebTab2Param, che al suo interno cerca la fine delle partite disponibili; potrebbe corrispondere al seguente codice:
- Codice: Seleziona tutto
Sub GetWebTab2ParamZ1(lUrl)
Dim IE As Object, F As Long
Dim cTdCnt As Long
Dim myRColl, myDColl, KK As Long, I As Long, J As Long, myColl, myR, myTD
'
myurl = lUrl
Set IE = CreateObject("InternetExplorer.Application")
'
'With IE
IE.navigate myurl
IE.Visible = True
reLoop:
Do While IE.busy: DoEvents: Loop 'Attesa not busy
Do While IE.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
'Specifico della versione Z1 >>>:
Set myTD = IE.document.getElementsByTagName("TD")
If myTD.Length = cTdCnt Then GoTo noLoop
cTdCnt = myTD.Length
On Error Resume Next
IE.document.getElementById("tournament-page-results-more").getElementsByTagName("a")(0).Click
On Error GoTo 0
myStart = Timer 'attesa javascript
Do
DoEvents
If Timer > myStart + 4 Or Timer < myStart Then Exit Do
Loop
GoTo reLoop
'<<< Fine parte specifica
'
noLoop:
'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
C'e' un blocco "Specifico della versione Z1", ma anche piccole differenze al resto del codice.
Teoricamente questa versione potrebbe sostituire anche la generica Sub GetWebTab2Param che gia' conosci, ma suggerisco di usare questa versione solo per il caso di cui parliamo, e usare la precedente Sub GetWebTab2Param per tutte le condizioni standard.
Come e' noto l'esecuzione di javascript (che e' quello che c'e' dietro il link "Mostra più incontri") non provoca modifiche agli stati IE.Busy e IE.ReadyStatus,pertanto il completamento e' controllato con un ritardo di 4 secondi; siccome ci sono 5-6 pagine aggiuntive da caricare il tempo di esecuzione facilmente arrivera' sui 25-30 secondi.
Fai sapere, ciao
Registrazione
