Vba e Selenium doppio ciclo

[Anthony47]

Per allegare un file:
viewtopic.php?f=26&t=103893&p=605487#p605487

[Gianca532011]

Proseguo qui in quanto è il naturale sviluppo.
Le modifiche : la macro PrintTables effettua la ricerca su due pagine Web (scheda + Dati completi ) per 2 Url (Mot eTLX) creando apposito folglio TLX . E questa (sembra) funziona bene .
Ora il problema : la seconda macro che dovrebbe riportare i dati pescandoli dal MOT o dal TLX si inceppa quando deve importare dal TLX con messaggio di errore : Indice non incluso nell'intervallo e debug che evidenzia La riga Redim TArr(1 to TbCol.count).
Dove sbaglio ?


https://ufile.io/inm6uw0o

[Anthony47]

I seguenti url restituiscono una pagina di ricerca, non la pagina di quel titolo, quindi senza tabelle:

Codice: Seleziona tutto

https://www.borsaitaliana.it/borsa/obbligazioni/eurotlx/scheda/IT0005480980.html?lang=it
https://www.borsaitaliana.it/borsa/obbligazioni/eurotlx/scheda/XS1768067297.html?lang=it
https://www.borsaitaliana.it/borsa/obbligazioni/eurotlx/scheda/XS1768074319.html?lang=it
https://www.borsaitaliana.it/borsa/obbligazioni/mot/btp/scheda/USL4441RAA43.html?lang=it


Per evitare che su queste situazioni di errore (la macro non sa dove vanno prelevate le info di un certo titolo, dovresti saperlo pero' tu) ho modificato il codice:
1) Nella GimmeTableArr:

Codice: Seleziona tutto

    Set TBColl = lDriver.FindElementsByTag("table")         'Esistente
    If TBColl.Count > 0 Then I = TBColl.Count Else I = 1    'Aggiunta
    ReDim TArr(1 To I)                                      'Modificata


2) Nella caller ho aggiunto un livello di If /Endif "attorno" al ciclo For J = 2 To Last1 /Next j:

Codice: Seleziona tutto

                If Not IsEmpty(AllTabs(1)) Then                                   '<<< IF /END IF Aggiuntivo
                    For J = 2 To Last1                          'Cerca l'intestazione di ogni colonna...
                        myHead = Cells(1, J).Value
                        For K = 1 To UBound(AllTabs)            '... in tutte le tabelle della pagina...
                            For L = 1 To UBound(AllTabs(K))     '.... in tutte le righe di ogni tabella
                                'Se "Trovato" allora scrivi il valore:
                                If InStr(1, AllTabs(K)(L, 1), myHead, vbTextCompare) = 1 Then
                                    If Cells(I, J) = "" Then Cells(I, J) = AllTabs(K)(L, 2)
                                End If
                            Next L
                        Next K
                    Next J
                End If                                       <<<<<<<<


Queste modifiche servono solo a evitare che la macro si fermi se indirizzata a cercare le info nel posto sbagliato

Ciao

[Gianca532011]

Grazie Anthony,
per funzionare funziona ma effettua un mare di interrogazioni (vedi file allegato) come se andasse avanti-indietro piu volte. Ciò ovviamente la rallenta molto, ora se il codice è corretto amen , ma non vorrei che ci sia qualche mio svarione di mezzo

https://ufile.io/xy5oirt4

Codice: Seleziona tutto

Option Explicit
Dim WPage As Object

Sub Caller()
'http://www.pc-facile.com/forum/viewtopic.php?f=26&t=112311&p=660077#p660077
    Dim myIsin As String, myUrl As String, LastA As Long, I As Long, Last1 As Long
    Dim AllTabs, J As Long, K As Long, L As Long, myHead As String, P As Long
    Dim S(1 To 2), Z As Integer

    'Crea Driver:
    If WPage Is Nothing Then
        Set WPage = CreateObject("Selenium.ChromeDriver")
        WPage.Start "Chrome"
    WPage.AddArgument ("--headless")
    End If
    Sheets("dataColl").Select
    '
    LastA = Cells(Rows.Count, "A").End(xlUp).Row            'Quanti Isin?
    Last1 = Cells(1, Columns.Count).End(xlToLeft).Column    'Quante colonne?
    '
    Range("B2").Resize(LastA + 10, Last1 + 5).ClearContents
    Sheets("Isin").Range("j2:N1000").Clear
   
    S(1) = ("AllTables")
    S(2) = ("Tlx")

    For Z = 1 To 2    ' cerca sui due fogli
        For P = 1 To 2                                      'Cerca su ambedue le pagine web
            For I = 2 To LastA                              ' per ogni Isin
                myIsin = Cells(I, 1)
                If P = 1 Then
                    myUrl = "https://www.borsaitaliana.it/borsa/obbligazioni/mot/btp/scheda/" & myIsin & ".html?lang=it"
                Else
                    myUrl = " https://www.borsaitaliana.it/borsa/obbligazioni/eurotlx/scheda/" & myIsin & ".html?lang=it"
                End If
                AllTabs = GimmeTablesArr(WPage, myUrl)      'Ottieni la matrice delle tabelle
                If Not IsEmpty(AllTabs(1)) Then                                   '<<< IF /END IF Aggiuntivo
                    For J = 2 To Last1                          'Cerca l'intestazione di ogni colonna...
                        myHead = Cells(1, J).Value
                        For K = 1 To UBound(AllTabs)            '... in tutte le tabelle della pagina...
                            For L = 1 To UBound(AllTabs(K))     '.... in tutte le righe di ogni tabella
                                'Se "Trovato" allora scrivi il valore:
                                If InStr(1, AllTabs(K)(L, 1), myHead, vbTextCompare) = 1 Then
                                    If Cells(I, J) = "" Then Cells(I, J) = AllTabs(K)(L, 2)
                                End If
                            Next L
                        Next K
                    Next J
                End If
               
                Next I
        Next S
    Next Z
    '
    'Quit Selenium
    WPage.Close
    WPage.Quit
     
    'allinea a dx
     Range("A" & LastA & Last1).Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
          End With
     
      ' copia dati su foglio Isin
    Range("B2:F" & LastA).Select
    With Selection
    .Copy
    Sheets("Isin").Select
    Range("J2").Select
    ActiveSheet.Paste
          End With
   
    Set WPage = Nothing
    MsgBox ("Informazioni raccolte...")
End Sub

Function GimmeTablesArr(lDriver As Object, myUrl As String) As Variant
    Dim PColl As WebElements, myItm As Object, TBColl As Object, pCount As Long
    Dim I As Long, myTim As Single
    Dim TArr()
'
    With lDriver
    .Get myUrl
   
    myTim = Timer
    '
    Set TBColl = lDriver.FindElementsByTag("table")
    If TBColl.Count > 0 Then I = TBColl.Count Else I = 1    'Aggiunta
     ReDim TArr(1 To I)
   
    '
    For I = 1 To TBColl.Count
        TArr(I) = TBColl(I).AsTable.Data
    Next I
    GimmeTablesArr = TArr
    End With
   
    Debug.Print "GTArr:", "Tables: " & I - 1, Format(Timer - myTim, "0.00"), myUrl
End Function




[Anthony47]

Queste istruzioni a che scopo mirano?

Codice: Seleziona tutto

    S(1) = ("AllTables")
    S(2) = ("Tlx")
    For Z = 1 To 2    ' cerca sui due fogli
'..
'..
    Next Z

Così come sono messe fanno solo ripetere un'altra volta il ciclo gia' completato, se le togli il risultato non cambia e impieghi meta' del tempo che impieghi ora.

Ricorda che le tabelle raccolte sul foglio AllTables (e Tlx, nel tuo file) servono solo per ispezionare quali dati sono reperibili a uno specifico url, per poter poi organizzare la tabella di raccolta dati. Nella fase di raccolta dati (Sub Caller) il contenuto di AllTables (e di Tlx) non viene piu' esaminato.

Ciao

[Gianca532011]

Ricorda che le tabelle raccolte sul foglio AllTables (e Tlx, nel tuo file) servono solo per ispezionare quali dati sono reperibili a uno specifico url, per poter poi organizzare la tabella di raccolta dati. Nella fase di raccolta dati (Sub Caller) il contenuto di AllTables (e di Tlx) non viene piu' esaminato.

Effettivamente avevo un po di confusione in testa . Tolto tutto, adesso va decisamente meglio.
Di nuovo grazie .

Qui il file finale.

https://ufile.io/9d6bpfy1

[Gianca532011]

Sempre in fase di test mi accade che dopo aver lanciato la caller, alla fine del mio elenco degli isin viene inserita una nuova riga che duplica l'ultima. Non riesco a capire come mai ?
allego test.

https://ufile.io/952j657t

[Gianca532011]

Ho corretto con questa :

Codice: Seleziona tutto

Dim uR As Long
    uR = Sheets("DataColl").Cells(Rows.Count, 1).End(xlUp).Row   << esistente
  Range("A" & uR + 1).Select
  Selection.EntireRow.Delete

ma non ho capito perchè si ha questa aggiunta mentre, stesso codice, funziona perfettamente con altri riferimenti (Url.)

[Anthony47]

Non ho capito dove hai fatto quella modifica.

Ne' ho capito perche' tra Next I e Next P e' presente questo blocco:

Codice: Seleziona tutto

        Next I
        AllTabs = GimmeTablesArr(WPage, myUrl)      'Ottieni la matrice delle tabelle
        If Not IsEmpty(AllTabs(1)) Then        '<<< IF /END IF Aggiuntivo
            For J = 2 To Last1                          'Cerca l'intestazione di ogni colonna...
                myHead = Cells(1, J).Value
                For K = 1 To UBound(AllTabs)            '... in tutte le tabelle della pagina...
                    For L = 1 To UBound(AllTabs(K))     '.... in tutte le righe di ogni tabella
                        'Se "Trovato" allora scrivi il valore:
                        If InStr(1, AllTabs(K)(L, 1), myHead, vbTextCompare) = 1 Then
                            If Cells(I, J) = "" Then Cells(I, J) = AllTabs(K)(L, 2)
                        End If
                    Next L
                Next K
            Next J
        End If
    Next P


Questo "semplicemente" rilegge l'ultimo url valido e ne riporta nuovamente i valori sulla riga 11

Ciao

[Gianca532011]

Grazie Anthony, il copia e incolla -senza senso critico, ovvero "cervello scollegato" - mi ha fregato. Avevo copiato il codice da un'altra procedura nella quale avevo due fogli con 2 url per ciascun foglio, quindi con 4 url di riferimento . Ancora grazie.

[Gianca532011]

Ciao,
ho l'ennesimo problema che si crea non per cattivo funzionamento del codice ma per la sua lentezza complessiva. Spiego, da uno stesso sito devo scaricare dati da n.4 collegamenti diversi che, con il solito ciclo For vado a interrogare in sequenza. Quindi, mi chiedo, non è possibile che per un singolo isin (vedi) aprire in simultanea i 4 Url e quindi prelevare cioò che serve ?

Allego file di esempio nel quale ho già preparato la pagina con gli url da interrogare o vvero gli estessi che si trovano nella Caller, modulo Chiamata .

https://ufile.io/ivool1qc

[Anthony47]

Al contrario della libreria Microsoft, Selenium non dispone di "eventi", ne' consente di gestire autonomamente l' attesa di fine operazione (teoricamente e' possibile impostare timeout espliciti, ma quando ci ho provato il risultato e' sempre stato a me incomprensibile).
Quindi la risposta e', con le mie conoscenze, negativa.

Sorry...

[Gianca532011]

Ciao Anthony, proseguo da qui in quanto la domanda riguarda la tua PrintTables che ho dovuto modificare per potela utilizzare con un nuovo url.
In questa nuova veste però mi si ferma alla table 1 e le altre ? so per certo che ce ne sono almeno 23 . Essendo rimaneggiata non vorrei aver fatto pasticci.

Codice: Seleziona tutto


Option Explicit
Dim WPage As Object

Sub PrintTables() ' questa mi serve per sapere quali e quante tabelle ho in ogni Isin da scaricare
    Dim myIsin As String
    Dim I As Integer, J As Integer
    Dim Tlx As Worksheet
    Dim myUrl As String
    Application.DisplayAlerts = False
             
    'Crea Driver:
    If WPage Is Nothing Then
        Set WPage = CreateObject("Selenium.ChromeDriver")
    End If
       
   
    WPage.Start
    With WPage
    Sheets("AllTables").Select
    Range("A:M").ClearContents

        Cells(1, 1) = "ETF tabelle "
     
        myIsin = "LU0476289623"   ' è un Etf
       
        myUrl = "https://www.morningstar.it/it/etfs/default.aspx" & myIsin
           
        .Window.Maximize
        .Get myUrl
        .Wait 1500
                                           
        .FindElementById("onetrust-accept-btn-handler").Click      ' cookies
        .Wait 1500
       
        .FindElementById("btn_individual").Click                   ' individuale
        .Wait 1500
         
        .FindElementById("quoteSearch").Click
        .SendKeys myIsin
        .Wait 1000
        .FindElementByCss(".ac_results").Click
        .Wait 1500
         
   
        Call GetAllTablesArr(myUrl, 1, 1)         'Posiziona in colonna A
         .Wait 1500
     End With
       
        WPage.Close
        WPage.Quit
   
    Range("A:M").Select
    Selection.Columns.AutoFit


    Set WPage = Nothing
    MsgBox ("Informazioni raccolte...")
    Application.DisplayAlerts = True

End Sub

Sub GetAllTablesArr(myUrl As String, Optional rNum0 As Long = 1, Optional cNum0 As Long = 1)
    Dim TBColl As Object
    Dim I As Long, J As Long, myTim As Single
    Dim RNum As Long, CNum As Long
   
    Dim TArr

    If WPage Is Nothing Then
        Set WPage = CreateObject("Selenium.ChromeDriver")
    End If
    WPage.Get myUrl
    '
    myTim = Timer
    '
    Set TBColl = WPage.FindElementsByTag("table")
    RNum = rNum0: CNum = cNum0
    '
    For I = 1 To TBColl.Count               'Scan delle Tabelle presenti
        TArr = TBColl(I).AsTable.Data
        RNum = RNum + 1
        Cells(RNum, CNum).Value = "## Table " & I
        If (UBound(TArr) * UBound(TArr, 2)) > 0 Then
            Cells(RNum + 1, CNum).Resize(UBound(TArr), UBound(TArr, 2)).Value = TArr
        End If
        RNum = RNum + UBound(TArr) + 1
        DoEvents
    Next I
    Debug.Print "FINE", RNum, Format(Timer - myTim, "0.00"), myUrl
End Sub



[Gianca532011]

E qui il link al file .

https://www.dropbox.com/s/voeokbu3pobcb ... .xlsm?dl=0

[Anthony47]

Il fatto e' che tu all'interno della Sub PrintTables fai una navigazione per arrivare a un certo Url, ma poi chiami la GetAllTablesArr con l'Url di partenza, distruggendo in questo modo la navigazione fino alla pagina del titolo cercato.
Per non alterare il concetto della GetAllTablesArr (leggere le tabelle da qualsiasi url) modifichiamo la sua chiamata passandogli l'url di arrivo post navigazione; che vuol dire aggiungere modificare la chiamata come segue:

Codice: Seleziona tutto

''        Call GetAllTablesArr(myUrl, 1, 1)         'Posiziona in colonna A          OLD
        Call GetAllTablesArr(WPage.Url, 1, 1)         'Posiziona in colonna A          NEW


Ciao

[Gianca532011]

Perfetto ! Logica ineccepibile la tua ! Adesso funziona regolarmente.
Altra domanda : con dataColl è possibile per ogni Isin scaricare tutto ciò che è contenuto nelle varie table ? In pratica in rigo 1 metterei :
Table 21 Table 22 Table 23 Table 24 ... ciascun riferimento nella sua colonna ? Oppure devo cambiare metodo ( vedi file di esempio )

[Anthony47]

Non sono certo di aver capito la domanda; se e' "come posso importare intere tabelle a scelta" allora la mia proposta e' di rimodulare leggermente la Sub GetAllTablesArr e renderla programmabile.
Ad esempio:

Codice: Seleziona tutto

Sub GetModTablesArr(myUrl As String, Optional rNum0 As Long = 1, Optional cNum0 As Long = 1, Optional TabList As String)
    Dim TBColl As Object
    Dim I As Long, J As Long, myTim As Single
    Dim RNum As Long, CNum As Long
   
    Dim TArr

    If WPage Is Nothing Then
        Set WPage = CreateObject("Selenium.ChromeDriver")
    End If
    WPage.Get myUrl
    '
    myTim = Timer
    '
    Set TBColl = WPage.FindElementsByTag("table")
    RNum = rNum0: CNum = cNum0
    '
    For I = 1 To TBColl.Count               'Scan delle Tabelle presenti
        TArr = TBColl(I).AsTable.Data
        RNum = RNum + 1
        If InStr(1, TabList & String(10, "#"), Format(I, "000"), vbTextCompare) > 0 Or Len(TabList) = 0 Then
            Cells(RNum, CNum).Value = "## Table " & I
            If (UBound(TArr) * UBound(TArr, 2)) > 0 Then
                Cells(RNum + 1, CNum).Resize(UBound(TArr), UBound(TArr, 2)).Value = TArr
            End If
            RNum = RNum + UBound(TArr) + 1
            DoEvents
        End If
    Next I
    Debug.Print "FINE", RNum, Format(Timer - myTim, "0.00"), myUrl
End Sub


Questa puo' importare TUTTE le tabelle (come la precedente Sub GetAllTablesArr) oppure un subset a scelta, basta compilare il nuovo attributo TabList all'atto della Call.
Esempio:

Codice: Seleziona tutto

        Call GetModTablesArr(WPage.Url, 1, 1, "001; 003; 009; 021")

Queste importa in verticale (come faceva la precedente versione) le tabelle 1, 3, 9 e 21
E' importante indicare le tabelle con 3 cifre (e andra' in crisi se ci sono piu' di 999 tabelle )

Quest'altra importera' tutte le tabelle (come faceva la precedente versione)

Codice: Seleziona tutto

        Call GetModTablesArr(WPage.Url, 1, 1)

Le tabelle saranno riportate sul foglio nella sequenza in cui compaiono nella pagina web, indipendentemente da come indicato nella Call; cioe' "002; 010; 015" oppure "015; 002; 010" rodurranno la stessa sequenza

Ciao