Risolto Check Debug e siti Internet

Mark87

Utente abituale
21 Aprile 2018
223
18
Milano
Excel 2010
0
Inserisco il codice sviluppato fino ad ora per comprendere meglio il tutto:

Visual Basic:
Sub ImportaTitoli()
'dichiarazione variabili
    Dim IE As Object
    Dim Doc As Object
    Dim HTMLAs As Object
    Dim HTMLA As Object
    Dim risultato1 As Double
    Dim risultato2 As Double

    Set IE = CreateObject("InternetExplorer.Application") 'variabile Internet Explorer

    IE.navigate "https://finance.yahoo.com/quote/CEFL?p=CEFL&.tsrc=fin-srch" 'naviga pagina
    IE.Visible = True 'finestra visibile (si può impostare anche a False)
    Do While IE.Busy: DoEvents: Loop 'Attesa not busy
    Do While IE.readyState <> 4: DoEvents: Loop 'Attesa documento

    Set Doc = IE.document 'variabile documento

    Set HTMLAs = Doc.GetElementsByClassName("Trsdu(0.3s) Fw(b) Fz(36px) Mb(-4px) D(ib)") 'collezione di elementi di tipo Class
    Sheets("CEFL").Range("D3") = HTMLAs(0).innerText 'scivi nella cella D3 del foglio CEFL il contenuto dell'elemento

    IE.navigate "https://finance.yahoo.com/quote/MORL?p=MORL&.tsrc=fin-srch" 'naviga pagina
    Do While IE.Busy: DoEvents: Loop 'Attesa not busy
    Do While IE.readyState <> 4: DoEvents: Loop 'Attesa documento

    Set HTMLAs = Doc.GetElementsByClassName("Trsdu(0.3s) Fw(b) Fz(36px) Mb(-4px) D(ib)") 'collezione di elementi di tipo Class
    Sheets("MORL").Range("D3") = HTMLAs(0).innerText 'scrivi nella cella D3 del foglio MORL il contenuto dell'elemento
    
    IE.navigate "https://finance.yahoo.com/quote/DHT?p=DHT&.tsrc=fin-srch" 'naviga pagina
    Do While IE.Busy: DoEvents: Loop 'Attesa not busy
    Do While IE.readyState <> 4: DoEvents: Loop 'Attesa documento

    Set HTMLAs = Doc.GetElementsByClassName("Trsdu(0.3s) Fw(b) Fz(36px) Mb(-4px) D(ib)") 'collezione di elementi di tipo Class
    Sheets("DHT").Range("D3") = HTMLAs(0).innerText 'scrivi nella cella D3 del foglio DHT il contenuto dell'elemento
    
    IE.navigate "https://finance.yahoo.com/quote/ET?p=ET&.tsrc=fin-srch" 'naviga pagina
    Do While IE.Busy: DoEvents: Loop 'Attesa not busy
    Do While IE.readyState <> 4: DoEvents: Loop 'Attesa documento

    Set HTMLAs = Doc.GetElementsByClassName("Trsdu(0.3s) Fw(b) Fz(36px) Mb(-4px) D(ib)") 'collezione di elementi di tipo Class
    Sheets("ENERGY TRANSFER").Range("D3") = HTMLAs(0).innerText 'scrivi nella cella D3 del foglio Energy Transfer il contenuto dell'elemento
    
    IE.navigate "https://finance.yahoo.com/quote/GLDI?p=GLDI&.tsrc=fin-srch" 'naviga pagina
    Do While IE.Busy: DoEvents: Loop 'Attesa not busy
    Do While IE.readyState <> 4: DoEvents: Loop 'Attesa documento

    Set HTMLAs = Doc.GetElementsByClassName("Trsdu(0.3s) Fw(b) Fz(36px) Mb(-4px) D(ib)") 'collezione di elementi di tipo Class
    Sheets("GLDI").Range("D3") = HTMLAs(0).innerText 'scrivi nella cella D3 del foglio GLDI il contenuto dell'elemento
    
    IE.navigate "https://finance.yahoo.com/quote/CLM?p=CLM&.tsrc=fin-srch" 'naviga pagina
    Do While IE.Busy: DoEvents: Loop 'Attesa not busy
    Do While IE.readyState <> 4: DoEvents: Loop 'Attesa documento

    Set HTMLAs = Doc.GetElementsByClassName("Trsdu(0.3s) Fw(b) Fz(36px) Mb(-4px) D(ib)") 'collezione di elementi di tipo Class
    Sheets("CORNESTONE CLM").Range("D3") = HTMLAs(0).innerText 'scrivi nella cella D3 del foglio CORNESTONE CLM il contenuto dell'elemento
    
    IE.navigate "https://finance.yahoo.com/quote/WMC?p=WMC&.tsrc=fin-srch" 'naviga pagina
    Do While IE.Busy: DoEvents: Loop 'Attesa not busy
    Do While IE.readyState <> 4: DoEvents: Loop 'Attesa documento

    Set HTMLAs = Doc.GetElementsByClassName("Trsdu(0.3s) Fw(b) Fz(36px) Mb(-4px) D(ib)") 'collezione di elementi di tipo Class
    Sheets("WMC").Range("D3") = HTMLAs(0).innerText 'scrivi nella cella D3 del foglio WMC il contenuto dell'elemento
    
    IE.navigate "https://finance.yahoo.com/quote/T?p=T&.tsrc=fin-srch" 'naviga pagina
    Do While IE.Busy: DoEvents: Loop 'Attesa not busy
    Do While IE.readyState <> 4: DoEvents: Loop 'Attesa documento

    Set HTMLAs = Doc.GetElementsByClassName("Trsdu(0.3s) Fw(b) Fz(36px) Mb(-4px) D(ib)") 'collezione di elementi di tipo Class
    Sheets("AT&T").Range("D3") = HTMLAs(0).innerText 'scrivi nella cella D3 del foglio AT&T il contenuto dell'elemento
    
    IE.navigate "https://finance.yahoo.com/quote/CRM?p=CRM&.tsrc=fin-srch" 'naviga pagina
    Do While IE.Busy: DoEvents: Loop 'Attesa not busy
    Do While IE.readyState <> 4: DoEvents: Loop 'Attesa documento

    Set HTMLAs = Doc.GetElementsByClassName("Trsdu(0.3s) Fw(b) Fz(36px) Mb(-4px) D(ib)") 'collezione di elementi di tipo Class
    Sheets("Salesforce").Range("D3") = HTMLAs(0).innerText 'scrivi nella cella D3 del foglio Salesforce il contenuto dell'elemento
    
    IE.navigate "https://finance.yahoo.com/quote/LEVMIB.MI?p=LEVMIB.MI&.tsrc=fin-srch" 'naviga pagina
    Do While IE.Busy: DoEvents: Loop 'Attesa not busy
    Do While IE.readyState <> 4: DoEvents: Loop 'Attesa documento

    Set HTMLAs = Doc.GetElementsByClassName("Trsdu(0.3s) Fw(b) Fz(36px) Mb(-4px) D(ib)") 'collezione di elementi di tipo Class
    Sheets("LEVMIB").Range("D3") = HTMLAs(0).innerText 'scrivi nella cella D3 del foglio LEVMIB il contenuto dell'elemento
    
    IE.navigate "https://finance.yahoo.com/quote/IUKD.SW?p=IUKD.SW&.tsrc=fin-srch" 'naviga pagina
    Do While IE.Busy: DoEvents: Loop 'Attesa not busy
    Do While IE.readyState <> 4: DoEvents: Loop 'Attesa documento

    Set HTMLAs = Doc.GetElementsByClassName("Trsdu(0.3s) Fw(b) Fz(36px) Mb(-4px) D(ib)") 'collezione di elementi di tipo Class
    Sheets("IUKD").Range("D3") = HTMLAs(0).innerText 'scrivi nella cella D3 del foglio IUKD il contenuto dell'elemento
    
    IE.navigate "https://www.borsaitaliana.it/borsa/etf/scheda/IE00B1TXK627.html?lang=it" 'naviga pagina
    Do While IE.Busy: DoEvents: Loop 'Attesa not busy
    Do While IE.readyState <> 4: DoEvents: Loop 'Attesa documento

    Set HTMLAs = Doc.GetElementsByClassName("t-text -size-lg -black-warm-60") 'collezione di elementi di tipo Class
    Sheets("IH20").Range("D3") = HTMLAs(0).innerText 'scrivi nella cella D3 del foglio IH20 il contenuto dell'elemento
    risultato1 = HTMLAs(0).innerText
    Sheets("IH20").Range("D3") = Replace(risultato1, ",", ".")
    
    IE.navigate "https://it.finance.yahoo.com/quote/MLPD.L?p=MLPD.L&.tsrc=fin-srch" 'naviga pagina
    Do While IE.Busy: DoEvents: Loop 'Attesa not busy
    Do While IE.readyState <> 4: DoEvents: Loop 'Attesa documento

    Set HTMLAs = Doc.GetElementsByClassName("Trsdu(0.3s) Fw(b) Fz(36px) Mb(-4px) D(ib") 'collezione di elementi di tipo Class
    Sheets("MLPD").Range("D3") = HTMLAs(0).innerText 'scrivi nella cella D3 del foglio MLPD il contenuto dell'elemento
    risultato2 = HTMLAs(0).innerText
    Sheets("MLPD").Range("D3") = Replace(risultato2, ",", ".")
    
    IE.Quit 'chiusura IE

    'eliminazione variabili
    Set IE = Nothing
    Set Doc = Nothing
    Set HTMLAs = Nothing
End Sub
In questo codice immenso mi da errore qui

Visual Basic:
Sheets("IUKD").Range("D3") = HTMLAs(0).innerText 'scrivi nella cella D3 del foglio IUKD il contenuto dell'elemento
Quando facciamo il debug.
 

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
18.842
113
Como
2011MAC 2016WIN
353
Allora, ti propongo un altro approccio più veloce che fa questo:
1) crea un foglio per ciascun indirizzo
2) estrae in ciascun foglio TUTT i dati di quella pagina internet (tu usa quelli che ti servono)

Il tutto con il mio computer in soli 6 secondi!

Visual Basic:
Sub ImportaWeb()
    Dim htm As Object
    Dim Tr As Object
    Dim Td As Object
    Dim Tab1 As Object
    Dim uR As Long
    Dim inizio As Double
    inizio = Timer
    Dim j As Long
    Dim Max As Long
    Sheets("Home").Activate
    Application.ScreenUpdating = False
    Max = 100
    InitProgressBar (Max)
    uR = Sheets("Home").Cells(Rows.Count, 1).End(xlUp).Row
    For j = 1 To uR
        DoEvents
        x = x + 8
        ShowProgress (j + x)
        NomeFoglio = "Foglio" & j
        If Sheets.Count <= 12 Then
            Sheets.Add
            ActiveSheet.Name = NomeFoglio
            With Sheets(NomeFoglio)
                .Move After:=Sheets(Worksheets.Count)
                .Cells(1, 1) = Sheets("Home").Cells(j, 1)
            End With
        End If
        Sheets(NomeFoglio).Range("A2:Z1000").ClearContents
        Web_URL = VBA.Trim(Sheets(NomeFoglio).Cells(1, 1))
        Set HTML_Content = CreateObject("htmlfile")
        With CreateObject("msxml2.xmlhttp")
            .Open "GET", Web_URL, False
            .send
            HTML_Content.Body.Innerhtml = .responseText
        End With
        Column_Num_To_Start = 1
        iRow = 2
        iCol = Column_Num_To_Start
        iTable = 0
        For Each Tab1 In HTML_Content.getElementsByTagName("table")
            For Each Tr In Tab1.Rows
                For Each Td In Tr.Cells
                    Sheets(NomeFoglio).Cells(iRow, iCol) = Td.innerText
                    iCol = iCol + 1
                Next Td
                iCol = Column_Num_To_Start
                iRow = iRow + 1
            Next Tr
            iTable = iTable + 1
            iCol = Column_Num_To_Start
            iRow = iRow + 1
        Next Tab1
       
        With Sheets(NomeFoglio).Columns("A:C")
            .ColumnWidth = 25
            .HorizontalAlignment = xlLeft
        End With
  
    Next
    Application.ScreenUpdating = True
    Sheets("Home").Activate
    CloseProgressBar
    MsgBox "Tempo impiegato " & Format(Timer - inizio, "00:00") & " secondi!"
End Sub


Sub InitProgressBar(MaxValue As Long)
    With ProgressBar
        .BarColor.Tag = .BarBorder.Width / MaxValue
        .BarColor.Width = 0
        .ProgressText = ""
        .Show vbModeless
    End With
End Sub

Sub CloseProgressBar()
    Unload ProgressBar
End Sub
Sub ShowProgress(Progress As Long)
    With ProgressBar
        .BarColor.Width = Round(.BarColor.Tag * Progress, 0)
        .ProgressText.Caption = Round((.BarColor.Width / .BarBorder.Width * 100), 0) & "% completato"
    End With
End Sub
P.S. - Ci metto anche una Progressbar per rendere l'applicativo più gradevole nell'attesa.
 

Allegati

  • Like
Reactions: Rubik72

Mark87

Utente abituale
21 Aprile 2018
223
18
Milano
Excel 2010
0
Sì grazie mille. Va benissimo però ci sono due ordini di problemi:

1) I fogli di lavoro non vengono nominati in base al nome del titolo. E' un casino nominarli in base al nome del titolo?
2) A me in circa 10 secondi ma questo perchè la connessione dove sono ora è penosa (sono con il cell che fa da router).
3) Una volta fatto partire questo file devo comunque legarlo all'altro file. Io vorrei che si facesse tutto in un unico file Excel.

La tua routine è fenomenale per l'estrazione di tutti i dati da una pagina Web, però mi manca un pezzetto che è quello di portare questi valore nella solita casella D3 del foglio di lavoro. Tu intendi che riesco a fare tutto con un solo file Excel?
 

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
18.842
113
Como
2011MAC 2016WIN
353
I fogli di lavoro non vengono nominati in base al nome del titolo. E' un casino nominarli in base al nome del titolo?
Si possono nominare come si vogliono ma io non ho idea quale sia nome da assegnare in base al titolo

mi manca un pezzetto che è quello di portare questi valore nella solita casella D3 del foglio di lavoro. Tu intendi che riesco a fare tutto con un solo file Excel?
Sicuramente si può fare, anzi è la cosa più facile, ma devi capire tu come farlo, io non so che dati ti servono e dove devono essere messi. Dovresti spiegare per ciascuno dei 12 fogli dove mettere i dati in un foglio Master
 

Mark87

Utente abituale
21 Aprile 2018
223
18
Milano
Excel 2010
0
I fogli di lavoro non vengono nominati in base al nome del titolo. E' un casino nominarli in base al nome del titolo?
Si possono nominare come si vogliono ma io non ho idea quale sia nome da assegnare in base al titolo

mi manca un pezzetto che è quello di portare questi valore nella solita casella D3 del foglio di lavoro. Tu intendi che riesco a fare tutto con un solo file Excel?
Sicuramente si può fare, anzi è la cosa più facile, ma devi capire tu come farlo, io non so che dati ti servono e dove devono essere messi. Dovresti spiegare per ciascuno dei 12 fogli dove mettere i dati in un foglio Master

Si però tu hai messo

Visual Basic:
For j = 1 To uR
        DoEvents
        x = x + 8
        ShowProgress (j + x)
        NomeFoglio = "Foglio" & j
        If Sheets.Count <= 12 Then
            Sheets.Add
            ActiveSheet.Name = NomeFoglio
            With Sheets(NomeFoglio)
                .Move After:=Sheets(Worksheets.Count)
                .Cells(1, 1) = Sheets("Home").Cells(j, 1)
            End With
        End If
Io penso che dovrei cambiare la struttura di questa routine però, altrimenti non si riesce a fare. Per esempio il primo foglio di lavoro deve essere chiamato CEFL, il secondo MORL.

Con questa metodologia tu hai tutta l base dati dal Web disponibile e quindi potenzialmente è più completa la cosa.

P.S Ho cambiato cell per il router e va in 3 secondi anche a me! Pazzesco!
 

Mark87

Utente abituale
21 Aprile 2018
223
18
Milano
Excel 2010
0
Si comunque se posso scriverti una cosa c'è un problema nel vecchio codice:

Visual Basic:
Set HTMLAs = Doc.GetElementsByClassName("t-text -size-lg -black-warm-60") 'collezione di elementi di tipo Class
    Sheets("IH20").Range("D3") = HTMLAs(0).innerText 'scrivi nella cella D3 del foglio IH20 il contenuto dell'elemento
    risultato1 = HTMLAs(0).innerText
    Sheets("IH20").Range("D3") = Replace(risultato1, ",", ".")
    
    IE.navigate "https://it.finance.yahoo.com/quote/MLPD.L?p=MLPD.L&.tsrc=fin-srch" 'naviga pagina
    Do While IE.Busy: DoEvents: Loop 'Attesa not busy
    Do While IE.readyState <> 4: DoEvents: Loop 'Attesa documento

    Set HTMLAs = Doc.GetElementsByClassName("Trsdu(0.3s) Fw(b) Fz(36px) Mb(-4px) D(ib") 'collezione di elementi di tipo Class
    Sheets("MLPD").Range("D3") = HTMLAs(0).innerText 'scrivi nella cella D3 del foglio MLPD il contenuto dell'elemento
    risultato2 = HTMLAs(0).innerText
    Sheets("MLPD").Range("D3") = Replace(risultato2, ",", ".")
Mi da errore qui:

Visual Basic:
Sheets("MLPD").Range("D3") = HTMLAs(0).innerText 'scrivi nella cella D3 del foglio MLPD il contenuto dell'elemento
Non è che questa riga di codice non si può sovrapporre perchè bisogna definire il Document come dice Rubik72 @Rubik72 che saluto.
Perchè sopra è lo stesso codice e non mi da errore. Assurdo.
 

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
18.842
113
Como
2011MAC 2016WIN
353
Ho cambiato cell per il router e va in 3 secondi anche a me! Pazzesco!
Te l'avevo detto è velocissima!

Io penso che dovrei cambiare la struttura di questa routine però, altrimenti non si riesce a fare. Per esempio il primo foglio di lavoro deve essere chiamato CEFL, il secondo MORL.
Invece si, basta prevederlo in un Array, per esempio prova questa sub
Visual Basic:
Sub myTest()
    MieiFogli = Array("Pippo", "Paperino", "Paperone", "Topolino")
    For j = LBound(MieiFogli) To UBound(MieiFogli)
        MsgBox MieiFogli(j)
    Next
End Sub
Nel tuo file dopo che hai assegnato il nome dei fogli in un Array scrivi così

Visual Basic:
For j = 1 To uR
NomeFoglio = MieiFogli(j - 1)
 

Mark87

Utente abituale
21 Aprile 2018
223
18
Milano
Excel 2010
0
Si però alcune precisazioni. Ti trovi che devo integrare questa sub che mi hai scritto in questo codice?

Visual Basic:
For j = 1 To uR
        DoEvents
        x = x + 8
        ShowProgress (j + x)
        NomeFoglio = "Foglio" & j
        If Sheets.Count <= 12 Then
            Sheets.Add
            ActiveSheet.Name = NomeFoglio
            With Sheets(NomeFoglio)
                .Move After:=Sheets(Worksheets.Count)
                .Cells(1, 1) = Sheets("Home").Cells(j, 1)
            End With
        End If
 

Mark87

Utente abituale
21 Aprile 2018
223
18
Milano
Excel 2010
0
Visual Basic:
Sub myTest()
    MieiFogli = Array("CEFL", "MORL", "DHT", "Energy Transfer")
    For j = LBound(MieiFogli) To UBound(MieiFogli)
        MsgBox MieiFogli(j)
    Next
End Sub
Il punto che non so precisamente è dove inserire queste righe di codice. A che altezza del tuo codice?

Poi dopo faccio la modifica all'altro file Excel.
 

Sostieni ForumExcel

Aiutaci a sostenere le spese e a mantenere online la community attraverso una libera donazione!