Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

[Macro]Importare dati da URL attivati con Javascript

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

[Macro]Importare dati da URL attivati con Javascript

Postdi daviluc61 » 31/12/17 11:41

Innanzitutto buongiorno a tutti e auguri per queste festività. Avrei bisogno delle vostre competenze per risolvere un problema di programmazione. Tramite la macro seguente, riesco a importare dati dal sito del myURL. Poichè nella tabella, e precisamente in colonna B vanno a finire dati che sul sito appaiono come link, come posso trasformare questa macro affinchè possa importare i dati con i link?
Infinitamente grazie
Codice: Seleziona tutto
Sub Macro1()

Application.Calculation = xlCalculationManual

myURL = "http://stats.betradar.com/s4/?clientid=5&language=it#2_1,3_17,22_1,5_41264,9_fixtures,231_full,23_1"

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")
For Each myItm In mycoll
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 + 1
Next myItm

ie.Quit
Set ie = Nothing
Calculate

End Sub
daviluc61
Utente Junior
 
Post: 15
Iscritto il: 31/12/17 11:33

Sponsor
 

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi Anthony47 » 02/01/18 20:07

Tramite la macro seguente, riesco a importare dati dal sito del myURL.
Questa macro la conosco...

Il sito in discussione (betradar.com) espone come hyperlink un suo javascript, quindi non c'e' un indirizzo sicuro associabile.
Ho simulato qualcosa guardando il comportamento dello script, ma quanto che questo approccio funzioni anche domani, o tra una settimana, o tra un mese nessuno te lo garantisce.
Il codice complessivo:
Codice: Seleziona tutto
Sub BetRadar()
'''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

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")
For Each myItm In mycoll
    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 myItm

IE.Quit
Set IE = Nothing
Calculate
End Sub


Prova e fai sapere...
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 15731
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi daviluc61 » 04/01/18 21:25

ti ringrazio Anthony. Risolto
daviluc61
Utente Junior
 
Post: 15
Iscritto il: 31/12/17 11:33

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi daviluc61 » 04/01/18 22:07

Anthony, una cosa volevo chiederti. Quando scarico il contenuto dei vari link, come posso scaricare anche le icone dei gol. Mi spiego meglio: quando scarico il link, mi trovo le voci dei diversi minuti in cui accadono le sostituzioni, i cartellini, i goal. Come posso scaricare solo i goal?. Grazie
daviluc61
Utente Junior
 
Post: 15
Iscritto il: 31/12/17 11:33

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi Anthony47 » 05/01/18 01:31

Parli degli hyperlink aggiunti sul foglio o di quali link? Inoltre, puoi pubblicare il codice che usi per la loro importazione?

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 15731
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi daviluc61 » 05/01/18 06:41

Parlo degli hyperlink scaricati con la macro precedente (myHL).
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"

Orbene quando scarico singolarmente questi hyperlink su un altro foglio, mi ritrovo una serie di minuti che, sul sito, sono affiancati a una icona (quella del goal, quella della sostituzione, etc) . A me interessa avere sul foglio solo i minuti che sono affiancati dalla icona del gol o, per lo meno, capire quali sono i minuti che sono affiancati dall'icona del gol.

<td class="goal icon sport-1 home first" title="Gol"><span class="goal icon sport-1 home"></span></td>)
<td class="goal icon sport-1 away" title="Gol"><span class="goal icon sport-1 away"></span></td>

Gentilissimo come sempre
daviluc61
Utente Junior
 
Post: 15
Iscritto il: 31/12/17 11:33

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi Anthony47 » 05/01/18 16:44

Quella macro e' nata per estrarre i dati tabellari da un sito, tu vuoi fare una cosa diversa.
Comunque modificando la parte centrale puoi ottenere anche l'indicazione di quale flag sia contenuto nella cella (yellow, goal, substitution):
Codice: Seleziona tutto
I = 1
Worksheets("Foglio2").Activate
Range("A:G").Clear
Set mycoll = IE.document.getElementsByTagName("TABLE")
For Each myItm In mycoll
    For Each tRtR In myItm.Rows
        For Each tDtD In tRtR.Cells
            picon = InStr(1, tDtD.classname, " icon", vbTextCompare)
            If picon > 0 Then
                Cells(I + 1, J + 1) = Left(tDtD.classname, picon ) & tDtD.innertext
            Else
                Cells(I + 1, J + 1) = tDtD.innertext
            End If
'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 myItm

Una volta che hai tutti i dati puoi estrarre /evidenziare quelli di tuo interesse e trascurare /cancellare gli altri.

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 15731
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi daviluc61 » 06/01/18 11:47

Anthony, grazie per la risposta, era ciò che volevo! C'è però un intoppo che non riesco a risolvere: nel foglio 2 ho estratto i vari indirizzi degli hyperlink. Adesso, attraverso un ciclo for... next prendo in successione i vari indirizzi e scarico i dati nel foglio 3. Se eseguo l'istruzione sottostante, i nuovi dati si sovrappongono ai primi. Ti chiedo: come posso accodare questi dati orizzontalmente, a partire dalla cella A1? Come posso modificare questa parte? Ti ringrazio

Codice: Seleziona tutto
Set Rng = Worksheets("Foglio2").Range(Range("A1"), Range("A1").End(xlDown))
For Each cel In Rng
    myURL = cel.Value   
    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("Foglio3").Activate
Set mycoll = IE.document.getElementsByTagName("TABLE")
For Each myItm In mycoll
    For Each tRtR In myItm.Rows
        For Each tDtD In tRtR.Cells
            picon = InStr(1, tDtD.classname, " icon", vbTextCompare)
            If picon > 0 Then
                Cells(I + 1, J + 1) = Left(tDtD.classname, picon) & tDtD.innerText
            Else
                Cells(I + 1, J + 1) = tDtD.innerText
            End If
            J = J + 1
        Next tDtD
        I = I + 1: J = 0
    Next tRtR
    I = I + 1
Next myItm
IE.Quit
Next cel
daviluc61
Utente Junior
 
Post: 15
Iscritto il: 31/12/17 11:33

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi Anthony47 » 06/01/18 20:37

Intanto e' utile che IE sia persistente per tutto il ciclo, senza bisogno di terminarlo e ricrearlo in continuazione.
Toccheremo quindi questa parte di codice
Codice: Seleziona tutto
'Altro codice
For Each cel In Rng                                             '****
    myURL = cel.Value
    Set IE = CreateObject("InternetExplorer.Application")       '****
With IE
    .navigate myURL
    '
    'altro codice
    '
        I = I + 1: J = 0
    Next tRtR
    I = I + 1
    Next myItm
IE.Quit         '****
Next cel        '****


Invertiamo la posizione delle celle marcate **** e inseriamo le modifiche per poter "mettere in colonna", in questo modo:
Codice: Seleziona tutto
Set IE = CreateObject("InternetExplorer.Application")           '**** SPOST
For Each cel In Rng                                             '**** SPOST
    zz = zz + 1                             '2222 AGG
    myURL = cel.Value
With IE
    .navigate myURL
    '
    'altro codice
    '
        I = I + 1: J = (zz - 1) * 10        '2222 MOD
    Next tRtR
    I = I + 1: J = zz * 10                  '2222 MOD
    Next myItm
   
Next cel        '**** SPOST
IE.Quit         '**** SPOST

Sono evidenziate le righe SPOSTate, e le modifiche per la messa in colonna (1 riga AGGiunta e 2 righe MODificate)

Ti raccomando di inserire il tag "Code" attorno alle righe di "codice": selezioni le righe di codice, premi il pulsate "Code" che trovi appena sopra l'area in cui si scrive il testo del messaggio; se non lo vedi, allora sei in "Risposta veloce", devi premere "Editor completo" per avere tutti i tool di formattazione del messaggio.

Prova e fai sapere....
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 15731
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi daviluc61 » 07/01/18 09:31

Anthony, grazie tanto. Ho risolto. Sei eccezionale per competenza e rara disponibilità. Ancora grazie
daviluc61
Utente Junior
 
Post: 15
Iscritto il: 31/12/17 11:33

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi daviluc61 » 08/01/18 07:43

Scusami, Antony, se ritorno sull'argomento. Poichè sto provando a scaricare dal sito diretta.it, come posso modificare l'istruzione che segue (quella che, per intenderci, mi hai fornito per il sito betradar), affinchè mi compaiano, vicino ai minuti, la descrizione dell'icona?. Mi spiego meglio. Sto scaricando i vari tabellini delle partite (esempio: "https://www.diretta.it/partita/fotcEqLq/#informazioni-partita") e vorrei che mi compaiano oltre ai minuti e ai calciatori, anche il tipo di evento (sostituzione, goal,cartellino)


myURL = "https://www.diretta.it/partita/fotcEqLq/#informazioni-partita"
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("Foglio2").Activate
Set mycoll = IE.document.getElementsByTagName("TABLE")
For Each myItm In mycoll
For Each tRtR In myItm.Rows
For Each tDtD In tRtR.Cells
picon = InStr(1, tDtD.classname, " icon", vbTextCompare)
If picon > 0 Then
Cells(I + 1, J + 1) = Left(tDtD.classname, picon) & tDtD.innerText
Else
Cells(I + 1, J + 1) = tDtD.innerText
End If
J = J + 1
Next tDtD
I = I + 1: J = 0
Next tRtR
I = I + 1
Next myItm


Grazie (... con la speranza di non disturbarti ancora)
daviluc61
Utente Junior
 
Post: 15
Iscritto il: 31/12/17 11:33

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi Anthony47 » 08/01/18 14:16

Queste automazioni sono sempre fatte su misura, secondo il sorgente html del sito; per dire che bisogna guardare il sorgente di www.diretta.it e vedere cosa si puo' riutilizzare.
Insomma ci vuole un po' piu' di tempo, devi aspettare...
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 15731
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi daviluc61 » 08/01/18 14:33

non ci sono probemi, è già tanto ciò che ho ottenuto. Aspetterò con pazienza.
daviluc61
Utente Junior
 
Post: 15
Iscritto il: 31/12/17 11:33

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi daviluc61 » 12/01/18 07:07

Gentilissimo Anthony,
posso confidare sulla tua disponibilità per risolvere il quesito che ti ho posto, inerente la descrizione dell'icona che scarico dalsito diretta.it?
Grazie ancora
daviluc61
Utente Junior
 
Post: 15
Iscritto il: 31/12/17 11:33

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi Anthony47 » 14/01/18 23:04

Ho modificato la precedente BetRadar2 per poter estrarre le icone di diretta.it; il nuovo codice (che dovrebbe funzionare anche su betradar.com):
Codice: Seleziona tutto
Sub GetRadar3()
'Vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=109246
Dim IE As Object
Dim myURL As String, myHL As String
Dim mySplit, tDtD, tRtR, tdIColl
Dim I As Long, J As Long, kI As Long, kIStr As String

myURL = "https://www.diretta.it/partita/fotcEqLq/#informazioni-partita"

'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("Foglio4").Activate
Range("A:G").Clear
Set mycoll = IE.document.getelementsbytagname("TABLE")
For Each myItm In mycoll
    For Each tRtR In myItm.Rows
        For Each tDtD In tRtR.Cells
            picon = InStr(1, tDtD.classname, " icon", vbTextCompare)
            If picon > 0 Then
                Cells(I + 1, J + 1) = Left(tDtD.classname, picon) & tDtD.innertext
            Else
            'per diretta.it>>:
                Set tdIColl = tDtD.getelementsbytagname("div")
                kIStr = ""
                If tdIColl.Length > 0 Then
                    For kI = 0 To tdIColl.Length - 1
                        If InStr(1, tdIColl(kI).classname, "icon-", vbTextCompare) > 0 Then
                            kIStr = ", " & Replace(tdIColl(kI).classname, "icon-box", "", , , vbTextCompare)
                            Exit For
                        End If
                    Next kI
                End If
            '<< per diretta.it
                Cells(I + 1, J + 1) = "'" & Trim(Replace(Replace(tDtD.innertext, Chr(10), " ", , , vbTextCompare), Chr(13), " ", , , vbTextCompare)) & kIStr
            End If
'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 myItm

IE.Quit
Set IE = Nothing
Calculate
End Sub


Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 15731
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi daviluc61 » 15/01/18 07:03

Eccezionale. Grazie tanto
daviluc61
Utente Junior
 
Post: 15
Iscritto il: 31/12/17 11:33

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi daviluc61 » 17/02/18 08:10

Scusami Anthony se ti importuno nuovamente. Con la macro seguente io importo la pagina iniziale del sito diretta.it estraendo i dati del giorno "oggi". Come è possibile trasformare questa macro affinchè possa scaricare i dati dei giorni precedenti o successivi (per intenderci quelli che vengono fuori cliccando il menu a tendina posto in alto a destra della home page di diretta.it. Questo argomento, se non erro, è già stato affrontato e risolto, solo che non riesco più a trovare la discussione: Ti ringrazio anticipatamente
Codice: Seleziona tutto
Sub GetWebTab2()
Dim IE As Object, F As Long
Dim myRColl, myDColl, KK As Long, I As Long, J As Long, myColl, myR, myTD

myURL = "http://www.diretta.it"
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

Application.Goto (Sheets("Foglio2").Range("A1"))       
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

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

Set IE = Nothing
End Sub
daviluc61
Utente Junior
 
Post: 15
Iscritto il: 31/12/17 11:33

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi Anthony47 » 19/02/18 15:36

In un'altra situazione avevo suggerito:
Codice: Seleziona tutto
Sub DirettaRis()
Dim IE As Object, myURL As String
'Dim myId As String, myCode As String
'
'myURL = "http://www.risultati.it/"
myURL = "https://www.diretta.it/"
If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")
With IE
    .Navigate myURL
    .Visible = True
    Do While .Busy: DoEvents: Loop    'Attesa not busy
    Do While .readyState <> 4: DoEvents: Loop 'Attesa documento
End With
 
myStart = Timer
Do  '1 sec prudenziale
    DoEvents
    If Timer > myStart + 1 Or Timer < myStart Then Exit Do
Loop
'
'

Set myItm = IE.document.getelementbyid("fscon")
'Vai alla gestione Giorni
myItm.getElementsByTagName("a")(6).Click    '<<< 0=Tutti, 1=Live, .... 6=Calendario
    Do While IE.Busy: DoEvents: Loop    'Attesa not busy
    Do While IE.readyState <> 4: DoEvents: Loop 'Attesa documento
Application.Wait (Now + TimeValue("0:00:04"))
'
'Seleziona un Giorno (0-14):
Set myItm = IE.document.getelementbyid("ifmenu-calendar-content")
myItm.getElementsByTagName("a")(7).Click    '<<< 0=-7gg, 1=-6gg,... 7=Oggi, etc
Application.Wait (Now + TimeValue("0:00:04"))
 
'Scaricare le tabelle:
Sheets("Foglio2").Select                '<<< Il foglio su cui leggere le tabelle
Range("A:P").ClearContents              '!!! !!! AZZERA FOGLIO CORRENTE SENZA PREAVVISO

Set myColl = IE.document.getElementsByTagName("TABLE")
'
For Each myItm In myColl
    For Each trtr In myItm.getElementsByTagName("tr")
        For Each tdtd In trtr.getElementsByTagName("td")
            Cells(myI + 1, myJ + 1) = tdtd.innerText
            myJ = myJ + 1
        Next tdtd
        myI = myI + 1: myJ = 0
    Next trtr
    myI = myI + 1
Next myItm
'
Range("A:Z").WrapText = False   '<<< Udattare il range se >A:Z
'< Fine importazione tabelle
'
'Stop
'
'Chiusura:
IE.Quit
Set IE = Nothing
End Sub


La selezione della data viene fatta nell'istruzione
Codice: Seleziona tutto
myItm.getElementsByTagName("a")(7).Click    '<<< 0=-7gg, 1=-6gg,... 7=Oggi, etc

Le possibili opzioni vanno da 0 a 14, con 7="Oggi", 6="ieri", 8="domani" e cosi' via

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 15731
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi daviluc61 » 19/02/18 20:24

Gentile e disponibile come sempre. Grazie
daviluc61
Utente Junior
 
Post: 15
Iscritto il: 31/12/17 11:33

Re: [Macro]Importare dati da URL attivati con Javascript

Postdi daviluc61 » 01/04/18 04:39

Gent.mo Anthony,
ritorno sull'argomento chiedendoti nuovamente aiuto. Con la macro sottostante io scarico i dati dal sito del myURL. Quando importo questi dati, mi manca però l'indicazione dei vari turni, sostituiti da una riga vuota. Come posso modificare la macro affinchè mi compaia l'indicazione dei vari turni? Ti ringrazio anticipatamente

Sub BetRadar()
'''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

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")
For Each myItm In mycoll
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 myItm

IE.Quit
Set IE = Nothing
Calculate
End Sub
daviluc61
Utente Junior
 
Post: 15
Iscritto il: 31/12/17 11:33

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "[Macro]Importare dati da URL attivati con Javascript":


Chi c’è in linea

Visitano il forum: Nessuno e 24 ospiti