Ho modificato il precedente ciclo For Each myItm In mycoll /Next myItm per prelevare anche lega e turno; il nuovo codice completo:
- Codice: Seleziona tutto
Sub BetRadarWTurno()
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=109246&p=643157
'''Application.Calculation = xlCalculationManual
Dim IE As Object
Dim myURL As String, myHL As String
Dim mySplit, tDtD, tRtR
Dim I As Long, J As Long
Dim Fl1st As Boolean, myH2Coll, CI As Long, myItm
myURL = "http://stats.betradar.com/s4/?clientid=5&language=it#2_1,3_17,22_1,5_41264,9_fixtures,231_full,23_1"
myHL = "http://stats.betradar.com/s4/?clientid=5&language=it#2_1,3_17,22_1,5_41264,9_match,8_#####,178_2055,7_2061"
Set IE = CreateObject("InternetExplorer.Application")
With IE
.navigate myURL
.Visible = True
Do While .Busy: DoEvents: Loop
Do While .readyState <> 4: DoEvents: Loop
End With
'
myStart = Timer
Do
DoEvents
If Timer > myStart + 2 Or Timer < myStart Then Exit Do
Loop
I = 1
Worksheets("Foglio1").Activate
Range("A:G").Clear
Set mycoll = IE.document.getElementsByTagName("TABLE")
Set myH2Coll = mycoll(0).parentElement.getElementsByTagName("h2")
For CI = 0 To mycoll.Length - 1
If CI = 0 Then
If myH2Coll.Length >= 1 Then
Cells(I + 1, 1) = myH2Coll(CI).innerText
I = I + 1
End If
End If
If CI <= myH2Coll.Length Then Cells(I + 1, 1) = myH2Coll(CI + 1).innerText: I = I + 1
Set myItm = mycoll(CI)
For Each tRtR In myItm.Rows
For Each tDtD In tRtR.Cells
Cells(I + 1, J + 1) = tDtD.innerText
'Per hLink>>:
Set piPP = tDtD.getElementsByTagName("a")
If piPP.Length > 0 Then
mySplit = Split(piPP(0).href, ",", , vbTextCompare)
If UBound(mySplit) = 2 Then
ActiveSheet.Hyperlinks.Add Anchor:=Cells(I + 1, J + 1), Address:= _
Replace(myHL, "#####", Trim(mySplit(1)), , , vbTextCompare), TextToDisplay:=Cells(I + 1, J + 1).Value
End If
End If
'<< End hLink
J = J + 1
Next tDtD
I = I + 1: J = 0
Next tRtR
I = I + 1
Next CI
'
IE.Quit
Set IE = Nothing
Calculate
End Sub
Fai sapere...
