importare da web

[rombotuono]

buongiorno
riprendendo un vecchio file mi accorgo che la macro che importava una specifica tabella purtroppo non funziona piu' molto probabilmente ci sono stati degli aggiornamenti .
chiedo gentilmente se si puo' modificare in modo da poter importare i dati presenti nella tabella Head-to-head .
grazie
allego il file
http://www.filedropper.com/rom

[Anthony47]

Non ho proprio idea di dove siano sulla pagina web i dati che vorresti importare

Comunque, come dico sempre, queste automazioni con I.E. sono dei giochi ti tempo e di pazienza e sono sempre "a tempo"; cioe' funzionano fino a quando non viene modificata la struttura della pagina web.

Ti propongo pertanto quest'altra variante che importa tutte le tabelle presenti sulla pagina:

Codice: Seleziona tutto

Sub Call1()
    Sheets("Foglio1").Select            '<<< Il foglio su cui si fara' l'importazione
    Range("A:X").ClearContents          'NB: Il fofglio SARA' AZZERATO senza preavviso
    Range("A:X").NumberFormat = "@"     'Colonne in formato Testo
    Call GetTabbbSub(Range("Y1").Value) '  "Chiama" la GetTabbbSub
    Range("A:X").WrapText = False
End Sub

Sub GetTabbbSub(ByVal myURL As String)
'Va Chiamata passandogli l'URL da leggere
Dim IE As Object
'
Set IE = CreateObject("InternetExplorer.Application")
'
With IE
    .navigate myURL
    .Visible = True
'Stop                                  'Vedi TESTO
    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 + 1 Or Timer < myStart Then Exit Do
Loop
'Scrive le tabelle SUL FOGLIO ATTIVO
Set myColl = IE.document.getElementsByTagName("TABLE")
For Each myItm In myColl
    Cells(I + 1, 1) = "Table# " & ti + 1
    ti = ti + 1: I = I + 1
    For Each trtr In myItm.Rows
        For Each tDtD In trtr.Cells
            Cells(I + 1, j + 1) = tDtD.innerText
            Cells(I + 1, j + 1).HorizontalAlignment = xlLeft
            'Legge hyperlink:
                If InStr(1, tDtD.innerHTML, "href", vbTextCompare) > 0 Then
                DoEvents: DoEvents
                    On Error Resume Next
                    ActiveSheet.Hyperlinks.Add anchor:=Cells(I + 1, j + 1), _
                       Address:=tDtD.getElementsByTagName("a")(0).href
                    On Error GoTo 0
                End If
            If j > 0 And Len(Cells(I + 1, j + 1)) > 2 Then cz = 1
            j = j + 1
        Next tDtD
        'Allinea al centro se e' una Intestazione:
        If trtr.className = "js-tournament" Then
            Cells(I + 1, 1).HorizontalAlignment = xlCenter
        End If
        I = I + 1: j = 0
DoEvents
    Next trtr
I = I + 1
Next myItm
'
'Chiusura IE
IE.Quit
Set IE = Nothing
End Sub


La riga marcata <<< determina su quale foglio lavorare; in Y1 deve contenere l'url da esaminare.

Una volta che hai tutte le tabelle potrai scegliere quella di tuo interesse e lavorare solo su quella

Ciao

[rombotuono]

ciao
grazie per la disponibilita'
comunque i dati sono nascosti in Show H2H matches
se non la importa con la tua macro, molto probabilmente non e' una tabella scaricabile.

http://www.filedropper.com/screenshot9_3

[Anthony47]

Ho modificato in un paio di punti la per consentire il click di "Show H2H matches".

Il codice completo:

Codice: Seleziona tutto

Sub Call1()
''    Sheets("Foglio1").Select            '<<< Il foglio su cui si fara' l'importazione
    Range("A:X").ClearContents          'NB: Il fofglio SARA' AZZERATO senza preavviso
    Range("A:X").NumberFormat = "@"     'Colonne in formato Testo
    Call GetTabbbSub(Range("Y1").Value) '  "Chiama" la GetTabbbSub
    Range("A:X").WrapText = False
End Sub

Sub GetTabbbSub(ByVal myURL As String)
'Va Chiamata passandogli l'URL da leggere
Dim IE As Object, PH2 As Boolean

Set IE = CreateObject("InternetExplorer.Application")
'
With IE
    .navigate myURL
    .Visible = True
'Stop                                  'Vedi TESTO
End With
Fase2:
With IE
    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 + 1 Or Timer < myStart Then Exit Do
Loop
If PH2 = False Then
    IE.document.getElementById("mutual_div").getElementsByTagName("a")(0).Click
'    IE.document.getElementById("mutual_div").getElementsByTagName("a")(0).FireEvent "onclick"
    PH2 = True
    GoTo Fase2
End If
'Scrive le tabelle SUL FOGLIO ATTIVO
Set myColl = IE.document.getElementsByTagName("TABLE")
For Each myItm In myColl
    Cells(I + 1, 1) = "Table# " & ti + 1
    ti = ti + 1: I = I + 1
    For Each trtr In myItm.Rows
        For Each tDtD In trtr.Cells
            Cells(I + 1, j + 1) = tDtD.innerText
            Cells(I + 1, j + 1).HorizontalAlignment = xlLeft
            'Legge hyperlink:
                If InStr(1, tDtD.innerHTML, "href", vbTextCompare) > 0 Then
                DoEvents: DoEvents
                    On Error Resume Next
                    ActiveSheet.Hyperlinks.Add anchor:=Cells(I + 1, j + 1), _
                       Address:=tDtD.getElementsByTagName("a")(0).href
                    On Error GoTo 0
                End If
            If j > 0 And Len(Cells(I + 1, j + 1)) > 2 Then cz = 1
            j = j + 1
        Next tDtD
        'Allinea al centro se e' una Intestazione:
        If trtr.className = "js-tournament" Then
            Cells(I + 1, 1).HorizontalAlignment = xlCenter
        End If
        I = I + 1: j = 0
DoEvents
    Next trtr
I = I + 1
Next myItm
'
'Chiusura IE
IE.Quit
Set IE = Nothing
End Sub


La tabella di tuo interesse e' la Table# 6

Ciao

[rombotuono]

grazie
tutto ok
sei fantastico