EXCEL WEB MULTIPLE PAGE TABLE QUERY

[niubbophys]

Buongiorno a tutti!

Mi collego alle discussioni molto simili avviate da brik32544 (viewtopic.php?f=26&t=100356) e da dragonedellenuvole (viewtopic.php?t=88282)

Premetto che seguendo le indicazioni date a brik32544 (con le opportune modifiche) sono riuscito nel mio intento, ossia scaricare i dati dei contratti dal sito borsaitaliana relativamente ad un dato ISIN.
Adesso quello che mi piacerebbe fare sarebbe automatizzare la procedura, ossia non dover per ogni titolo di mio interesse aprire excel, poi fare la query con l'indirizzo alla pagina del titolo, poi la macro indicata qui etc, ma aprire excel e lanciare direttamente la macro che mi scaricherà i dati di giornata relativamente ai contratti: in pratica desidererei quanto richiesto dall'utente dragonedellenuvole nella vecchia discussione (viewtopic.php?t=88282)

Ho provato a lavorarci su, usando le indicazioni date sia qui che nella vecchia discussione, ma non sono arrivato a nulla; un po' sarà la mia inesperienza in materia, un po' sarà che probabilmente sto affogando in un bicchiere d'acqua.

Quindi riassumendo: come faccio a scaricare automaticamente i contratti di questo titolo, ad esempio http://www.borsaitaliana.it/borsa/azion ... =it&page=0 e pagine successive?

Grazie in anticipo a chiunque possa darmi un aiuto.

PS: uso MS Office 2013 e ogni pagina dei contratti contiene al massimo 20 contratti.

[Anthony47]

Ciao niubbophys, benvenuto nel forum.
Quei dati li potrai importare solo con una macro che legga il sorgente html delle pagine e preleva i dati di interesse.
Ad oggi (perche' il codice html puo' cambiare a piacere del gestore del sito) una macro come questa importa i contratti presentati:

Codice: Seleziona tutto

Sub GetTabContr()
Dim BetFlag As Boolean, myURL0 As String, myURL1 As String, myColl, myItm
Dim myInner As String, myPages
myURL0 = "http://www.borsaitaliana.it/borsa/azioni/aim-italia/contratti.html?isin="
myURL1 = "&lang=it&page="

Set ie = CreateObject("InternetExplorer.Application")
I = 1
    'Leggi le tabelle, sul foglio PRELIEVO
    Worksheets("PRELIEVO").Select
    Range("A2").Resize(20000, 10).ClearContents

For Page = 0 To 1000
    With ie
        .navigate myURL0 & Range("L1").Value & myURL1 & Page
        .Visible = True
        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 + 0.3 Or Timer < myStart Then Exit Do
    Loop
   
   
    Set myColl = ie.document.getElementsByTagName("p")
    For Each myItm In myColl
        If myItm.classname = "floatsx" Then
            myInner = Trim(Replace(myItm.innertext, "Pag. ", "", , , vbTextCompare))
            myPages = Split(myInner, "/", , vbTextCompare)
            Exit For
        End If
    Next myItm
'    I = 5
    Set myColl = ie.document.getElementsByTagName("TABLE")
    aaa = myColl.Length
    Set myItm = myColl(aaa - 1)
        If myItm.classname = "table_dati" Then
                For Each trtr In myItm.Rows
                    For Each tdtd In trtr.Cells
                    DoEvents
                        aaaa = tdtd.classname
                        If tdtd.classname <> "name" And tdtd.classname <> "aligndx" Then
                            If J = 1 Or J = 2 Or J = 3 Then
                                Cells(I + 1, J + 1) = CDbl(Trim(tdtd.innertext))
                            Else
                                Cells(I + 1, J + 1) = Trim(tdtd.innertext)
                            End If
                            J = J + 1
                        End If
                    Next tdtd
                    I = I + 1: J = 0
                Next trtr
            I = I + 1: J = 0
        End If
'    Next myItm
If Page = (CLng(myPages(UBound(myPages, 1))) - 1) Then Exit For
Next Page
'
MsgBox("Completato...")
Stop     'Vedi testo
'
'Chiusura IE
ie.Quit
Set ie = Nothing

End Sub


Sul file che contiene la macro dovra' essere presente un foglio chiamato PRELIEVO dove segnerai, in L1, il codice Isin del titolo che ti interessa (es IT0004781412); il foglio sara' azzerato da riga 2 in avanti senza preavviso all' avvio della macro e i dati prelevati dal sito saranno scritti da riga 2 in avanti.
Il tempo necessario alla macro dipendera' da quante pagine vanno scaricate; se scarichi, mettiamo, Unicredit, ti servira' "qualche minuto".
Dopo il messagebox di completamento, la macro si ferma sulla riga "Stop", per consentire un minimo di controllo di congruita' tra quanro scaricato e quanto presente sul sito; la riga "Stop" potra' poi essere eliminata.

Come gia' detto, il sorgente della pagina potra' variare domani, tra una settimana, tra un mese, tra un anno, ...; in quel caso i risultati saranno incongrui o la macro andra' in errore, e dovrai adattare il codice alla nuova impostazione.

Ciao

[niubbophys]

Mille grazie sia per la soluzione trovata che per la dettagliata spiegazione, ne terrò conto.

Approfitto della tua/vostra competenza in materia per togliermi un dubbio legato alla soluzione, molto meno automatizzata, che usavo fino a poco fa e che riprendeva quanto da tu indicato in questa discussione qui viewtopic.php?f=26&t=100356.
Avevo riarrangiato il codice per scaricare le pagine nel seguente modo

Codice: Seleziona tutto

Sub getTables()
Dim Dest As String, myRoot As String, I As Long, myRan As Range

Dest = "Foglio3"        '<< Il foglio dove sara' creato l' elenco
aaa = Selection.CurrentRegion.Address

myRoot = "URL;http://www.borsaitaliana.it/borsa/azioni/contratti.html?isin=IT0003506190&lang=it&page="
With Range("A1").QueryTable
    For I = 0 To 1000
        .Connection = myRoot & I
        .Refresh BackgroundQuery:=False
        Set myRan = Range(Range("A2"), Range("E2").End(xlDown))
        myRan.Copy Destination:=Sheets(Dest).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        If myRan.Rows.Count < 20 Then Exit For
        DoEvents
    Next I
End With
'
End Sub


Funzionava bene eccetto quando nella pagina c'era o
1) un solo contratto oppure
2) quando nella pagina conclusiva c'erano 20 contratti, ossia il massimo possibile.

Per risolvere (1) ho cambiato E2 con E1 ma per risolvere l'errore (2) cosa dovrei cambiare?

Grazie per il tempo dedicatomi. Buona serata

[Anthony47]

Ho notato che quando si richiede una pagina superiore al max disponibile viene riproposta la pag. 0; potresti quindi esaminare le cifre delle Ore e, se inferiore all' ultima posizionata su foglio Dest ritenere completato l'aggiornamento.
Mi sembra la soluzione piu' semplice.

Ciao

[niubbophys]

Ho notato che quando si richiede una pagina superiore al max disponibile viene riproposta la pag. 0; potresti quindi esaminare le cifre delle Ore e, se inferiore all' ultima posizionata su foglio Dest ritenere completato l'aggiornamento.
Mi sembra la soluzione piu' semplice.

Ciao

Buongiorno!

Scusa se rispondo solo adesso ma ho avuto un po' da fare.
Grazie al tuo consiglio sono riuscito a ottenere quello che desideravo.

Ora però mi sono accorto della seguente cosa nell'importazione dei contratti. Ti propongo un pezzettino di risultato.

17.34.31 6,15 1,91 172 Contratto Ordinario
17.34.31 6,15 1,91 2 Contratto Ordinario
17.34.31 6,15 1,91 8747 Contratto Ordinario
17.34.31 6,15 1,91 2 Contratto Ordinario
17.34.31 6,15 1,91 19752 Contratto Ordinario
17.34.31 6,15 1,91 252 Contratto Ordinario
17.34.31 6,15 1,91 2560 Contratto Ordinario
17.34.31 6,15 1,91 2549 Contratto Ordinario
17.30.31 6,15 1,91 6717798 Contratto Ordinario
17.24.50 6,15 1,91 246 Contratto Ordinario
17.24.48 6,15 1,91 377 Contratto Ordinario
17.24.48 6,15 1,91 1000 Contratto Ordinario
17.24.48 6,15 1,91 2500 Contratto Ordinario
17.24.48 6,15 1,91 1000 Contratto Ordinario
17.24.48 6,15 1,91 1623 Contratto Ordinario

Nella prima colonna c'è l'orario a cui è avvenuto il contratto. Il problema è che quella colonna non viene riconosciuta in formato orario, ossia se io volessi applicare una formula del tipo (=SE(A3>ORARIO(17;30;0); "A"; "B")) questa restituisce sempre A, mentre con la vecchia macro sopra, la colonna dell'ora veniva restituita come

17:30:28 1,134 0,89 3.736.492 Contratto Ordinario
17:24:54 1,134 0,89 11.734 Contratto Ordinario
17:24:54 1,134 0,89 1.000 Contratto Ordinario
17:24:47 1,134 0,89 8.200 Contratto Ordinario
17:24:47 1,134 0,89 194 Contratto Ordinario
17:24:47 1,134 0,89 565 Contratto Ordinario
17:24:47 1,134 0,89 858 Contratto Ordinario
17:24:47 1,134 0,89 5.431 Contratto Ordinario
17:24:47 1,134 0,89 428 Contratto Ordinario
17:24:47 1,134 0,89 3.768 Contratto Ordinario

e qui la formula viene eseguita correttamente.

Che cosa c'è da cambiare?

Sempre mille grazie per il prezioso aiuto. saluti!

[Anthony47]

Se dal sito importi in colonna A 17.34.31 e il tuo sepratore orario e' ":" allora prova a mettere subito prima di End Sub queste istruzioni:

Codice: Seleziona tutto

    Columns("A:A").Select
    Selection.Replace What:=".", Replacement:=":", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Ciao

[niubbophys]

Se dal sito importi in colonna A 17.34.31 e il tuo sepratore orario e' ":" allora prova a mettere subito prima di End Sub queste istruzioni:

Codice: Seleziona tutto

    Columns("A:A").Select
    Selection.Replace What:=".", Replacement:=":", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

Ciao

Grazie ancora funziona alla grande!

PS: avrei un'altra domanda ma non è inerente questo argomento, ma altresì non trovo nemmeno un topic specifico circa la mia richiesta. So bene che per un esperto come te è una sciocchezza... Non so se fartela direttamente in PVT.

[Anthony47]

Non sono in grado di rispondere a quesiti posti tramite messaggi privati, quindi ti aspettiamo sul forum...