Scarico dati Yahoo Finance da web

[EnricoBanco]

Ciao Anthony, ciao a tutti,

qui di seguito il codice per lo scarico dati da Yahoo Finance, di cui si parlò tempo fa con Anthony e con altri. Da Yahoo non riesco a scaricare il file dati delle quotazioni in automatico da file excel, infatti questo codice purtroppo non arriva più allo scarico del file. Ho IE 11. E neanche manualmente, cioè non c'è più il pulsante scarico dati.
Ma oggi per caso ho verificato che usando il browser Google è possibile. Ma questo codice lavorava da Internet Explorer. La domanda allora è la seguente: è possibile adattare questo codice per scaricare i dati di Yahoo Finance usando Google anzichè IE? Si può trovare qualche spunto? Ho provato a lavorarci un pò ma senza riuscirci e a cercare qui e su web ma senza risultato.
Grazie ;o)

Se ne parlò il dal 02/10/2017 a questo link:
viewtopic.php?f=26&t=108903

Codice: Seleziona tutto


Dim IE As Object                 'RIGOROSAMENTE IN TESTA AL MODULO

'Scarica i dati di un anno da Yahoo Finanza su una file csv

Sub mMain()

Dim aColl As Object, bColl As Object, myTIT As String, myPath As String
'
'myTIT = "ENEL"    '<<< Il titolo, senza ".MI"
Sheets("Dati").Select
If Range("A1").Value = "" Then Exit Sub
myTIT = Range("A1").Value


'myPath = "C:\PROVA"
Call ApriYF(myTIT)
Set aColl = IE.document.getElementById("Col1-1-HistoricalDataTable-Proxy") '.getElementsByTagName("input")
myWait (2)
mlink0 = IE.document.getElementsByClassName("Fl(end) Pos(r) T(-6px)")(0).getElementsByTagName("a")(0).href
'
'aColl.getElementsByTagName("input")(0).Click
myWait (0.2)
'
Set bColl = IE.document.getElementsByClassName("P(5px) W(37px) H(15px) Fl(start) Mb(5px) Cur(p) Bdbc($c-fuji-blue-1-a):h Bdbs(s) Bdbw(3px) Bdbc(t)")
'bColl(bColl.Length - 1).Click               'Max
myWait (0.2)
'
'IE.document.getElementsByClassName(" Bgc($c-fuji-blue-1-b) Bdrs(3px) Px(20px) Miw(100px) Whs(nw) Fz(s) Fw(500) C(white) Bgc($actionBlueHover):h Bd(0) D(ib) Cur(p) Td(n)  Py(9px) Miw(80px)! Fl(start)")(0).Click   'Finito
myWait (0.2)
'
IE.document.getElementsByClassName(" Bgc($c-fuji-blue-1-b) Bdrs(3px) Px(20px) Miw(100px) Whs(nw) Fz(s) Fw(500) C(white) Bgc($actionBlueHover):h Bd(0) D(ib) Cur(p) Td(n)  Py(9px) Fl(end)")(0).Click                'Applica
myWait (0.2)
mlink = mlink0
On Error Resume Next
mytim = Timer
Do
    mlink = IE.document.getElementsByClassName("Fl(end) Pos(r) T(-6px)")(0).getElementsByTagName("a")(0).href
    If Mid(mlink, InStr(1, mlink, "?period1", vbTextCompare) + 8, 7) <> _
     Mid(mlink0, InStr(1, mlink0, "?period1", vbTextCompare) + 8, 7) Then Exit Do
    If Timer > (mytim + 15) Then Exit Do
Loop
'Debug.Print Format(Timer - mytim, "0.00")
'Debug.Print 1, mlink0
'Debug.Print 2, mlink
On Error GoTo 0
myWait (0.5)
'GoTo impF
    IE.navigate mlink
myWait (0.2)
    mytim = Timer
    Do While IE.Busy
        DoEvents: If Timer > (mytim + 10) Then Exit Do:
    Loop           'Attesa not busy
    Do While IE.readyState <> 4
        DoEvents: If Timer > (mytim + 30) Then Exit Do
    Loop  'Attesa documento
On Error Resume Next
IE.Quit
Set IE = Nothing




End Sub

Sub ApriYF(ByVal myID As String, Optional mySt As Long = 0)
'
bURL = "https://it.finance.yahoo.com/quote/###.MI/history?p=###"
'Set IE = Nothing
If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")
'
With IE
    .navigate Replace(bURL, "###", myID, , , vbTextCompare)
    .Visible = True
    Do While .Busy: DoEvents: Loop              'Attesa not busy
    Do While .readyState <> 4: DoEvents: Loop   'Attesa documento
End With
If mySt > 0 Then Stop
End Sub

Private Sub myWait(ByVal WSec As Single, Optional ByVal TOut As Single = 10)
'Attende WSec secondi (o il doppio se mezzanotte)
Dim lTim As Single
'
lTim = Timer
Do
    DoEvents
    If Timer > (lTim + WSec) Then Exit Do
    DoEvents
    If Timer < lTim And Timer > WSec Then Exit Do
Loop
End Sub



[Anthony47]

Guarda, queste automazioni sono sempre un gioco a termine, nel senso che prima o poi qualcosa all'interno del sito cambia e rende necessario rifare il giochino daccapo.
Cambia poco che in questo caso l'elemento scatenante sia la non compatibilita' del sito con IE

Per Chrome so che esiste un componente chiamato Selenium in grado di rendere disponibile una interfaccia tra il browser e il vba, ma non ho mai deciso di provarlo, quindi non so anticipare i risultati.

Nel caso specifico, mi pare che la tua necessita' sia di estrarre lo storico di un tot di titoli.

Usando il vba, questo codice scarica dal sito la tabella che si trova sotto i dati di sintesi del titolo, appena sotto a dove normalmente si trova il comando "Scarica dati":

Codice: Seleziona tutto

    Dim IE As Object                 'RIGOROSAMENTE IN TESTA AL MODULO

'Scarica circa 6 mesi di storico sul foglio STORICO

Sub mMain()

Dim aColl As Object, bColl As Object, myTIT As String, myPath As String
Dim iSh As Worksheet, myItm As Object, tDtD As Object, tRtR As Object
Dim I As Long, KK As Long
'
'myTIT = "ENEL"    '<<< Il titolo, senza ".MI"
Sheets("Dati").Select
If Range("A1").Value = "" Then Exit Sub
myTIT = Range("A1").Value

'myPath = "C:\PROVA"
Call ApriYF(myTIT)
   
Set iSh = Sheets("Storico")

I = 0: KK = 1
iSh.Range("A5:Z2000").ClearContents
Set aColl = IE.document.getElementsbyTagName("TABLE")
For Each myItm In aColl
    If myItm.classname = "W(100%) M(0)" Then
        iSh.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
                iSh.Cells(I + 1, J + 1) = tDtD.innertext
                J = J + 1
            Next tDtD
            I = I + 1: J = 0
        Next tRtR
    End If
Next myItm
'
On Error Resume Next
IE.Quit
Set IE = Nothing
'
End Sub

Sub ApriYF(ByVal myID As String, Optional mySt As Long = 0)
'
bURL = "https://it.finance.yahoo.com/quote/###.MI/history?p=###"
'Set IE = Nothing
If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")
'
With IE
    .navigate Replace(bURL, "###", myID, , , vbTextCompare)
    .Visible = True
    Do While .Busy: DoEvents: Loop              'Attesa not busy
    Do While .readyState <> 4: DoEvents: Loop   'Attesa documento
End With
If mySt > 0 Then Stop
End Sub

    Private Sub myWait(ByVal WSec As Single, Optional ByVal TOut As Single = 10)
    'Attende WSec secondi (o il doppio se mezzanotte)
    Dim lTim As Single
    '
    lTim = Timer
    Do
        DoEvents
        If Timer > (lTim + WSec) Then Exit Do
        DoEvents
        If Timer < lTim And Timer > WSec Then Exit Do
    Loop
    End Sub


La macro legge il titolo in Dati!A1 e tramite IE scarica il contenuto della tabella sul foglio Storico
Questa tabella contiene circa 6 mesi di storico.

Non so se il tuo obiettivo e' creare dei file csv (nel qual caso potresti registrare una macro per salvare come CSV il foglio "Storico", e richiamarla in fondo al ciclo di importazione), o se invece ti servono direttamente i dati in Excel.
Se devi lavorare con un elenco di Titolo, allora penso che non ti sara' difficile creare un loop per ciclare su tutto l'elenco di titoli che metterai in Colonna A di Dati

Spero ti sia di qualche utilita'.

[EnricoBanco]

Fantastico, grazie mille!!!

[EnricoBanco]

Provo a dare un contributo. I dati importati sono in formato testo quindi aggiunto per i campi numerici da colonna B a G il seguente codice per la formattazione dei dati in formato numerico registrando una macro con il metodo "Testo in Colonne" (menù Dati) che lavora su colonna singola.

Grazie ancora Anthony!!!

Codice: Seleziona tutto

Sheets("Storico").Activate

 Range("B3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("B3"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
       
         Range("C3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("C3"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
       
        Range("D3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("D3"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
       
        Range("E3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("E3"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
       
        Range("F3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("F3"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
             
        Range("G3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("G3"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True