allora ho capito come mi hai detto. ma quel foglio Schedule non mi importa tutto completo ma mancano ancora dal 29/11 fino alla fine? come mai si è interrotto?
Per quanto riguarda questo foglio 2 sì, esatto volevo importare i 30 righe e anche 20 o 21 colonne. cmq ho sistemato il numero da 1 a 2 sono stato uno zuccone. Mi puoi dire se è tutto esatto dei codici.
- 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 = uurrll ' "http://www.betonews.com/table.asp?tp=2001&lang=en&dd=20&dm=5&dy=2014&df=1&dw=3"
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 >= 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 pippo()
'Classifica Principale
zzz = GetTabRaim222("http://espn.go.com/nhl/standings/_/group/1", 1, Sheets("Foglio1").Range("A3"))
If zzz <> 1 Then MsgBox ("Importazione di aaa fallita")
'Classifica Generale
zzz = GetTabRaim222("http://www.nhl.com/stats/team?reportType=game&report=teamsummary&season=20152016&gameType=2&aggregate=1", 1, Sheets("Foglio2").Range("A3"))
If zzz <> 1 Then MsgBox ("Importazione di bbb fallita")
'Classifica Home
zzz = GetTabRaim222("http://www.nhl.com/stats/team?reportType=game&report=teamsummary&season=20152016&gameType=2&aggregate=1&gameLocation=H", 2, Sheets("Foglio3").Range("A3"))
If zzz <> 1 Then MsgBox ("Importazione di ccc fallita")
'Classifica Road
zzz = GetTabRaim222("http://www.nhl.com/stats/team?reportType=game&report=teamsummary&season=20152016&gameType=2&aggregate=1&gameLocation=R", 2, Sheets("Foglio4").Range("A3"))
If zzz <> 1 Then MsgBox ("Importazione di ddd fallita")
'Schedule
zzz = GetTabRaim222("http://stats.betradar.com/s4/?clientid=1271&language=en#2_4,3_37,22_2,5_11202,9_fixtures,231_full,23_3", 2, Sheets("Foglio5").Range("A3"))
If zzz = 0 Then
MsgBox ("Importazione fallita")
Else
MsgBox ("Completato...")
End If
End Sub
