Sviluppare funzionalita su Microsoft Office con VBA Importare dati in tabella da una pagina web conosciuta

Login Registrati
Stai vedendo 25 articoli - dal 1 a 25 (di 32 totali)
  • Autore
    Articoli
  • #8676 Risposta
    PippoLogic80
    PippoLogic80
    Partecipante

      Salve a tutti, da un po' di tempo sto costruendo il mio piccolo database di film con excel, e per vari motivi avevo pensato di velocizzare le operazioni di importazione con una macro dedicata, usando magari il VBA con tanto di Userform e Sub.

      Per quanto riguarda Textbox e vari, riesco a districarmi discretamente, anche se non sono programmatore, qualche piccolo lavoretto riesco a farlo; ma importare dati da internet, mi mancava proprio.

      Spulciando su vari siti online ho trovato una Sub che fa al caso mio, quindi l'ho adattata alle mie esigenze, e devo dire che funziona egregiamente, importando i dati di mio interesse in tabelle consecutive su un foglio: quello che manca è l'importazione anche del titolo della tabella, in quanto non trovo il modo di prelevarlo.

      Una volta che ho i dati sul foglio, riesco tranquillamente a lavorarli con la Userform.

      Questo è il codice che utilizzo:

      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 = "https://www.imdb.com/title/tt0227445/fullcredits?ref_=tt_cl_sm#cast"
      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 'attesa addizionale
      Do
      DoEvents
      If Timer > myStart + 2 Or Timer < myStart Then Exit Do
      Loop
      
      Application.Goto (Sheets("Foglio3").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
      'Legge le tabelle dentro gli iframe:
      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
      '
      Cells.WrapText = False
      Range("A1").Select
      '
      IE.Quit
      Set IE = Nothing
      End Sub

      Questa Sub mi importa i dati di mio interesse, ma divide il tutto in TABELLA_0, TABELLA_1, TABELLA_2, ecc.; io vorrei che al posto di quelle diciture ci fosse: "Directed by", "Writing Credits", "Cast", ecc., proprio come sulla pagina web di origine.

      So' già che la parola TABELLA la genero con la macro, ed ho provato ad agire li, ma con le mie conoscenze proprio non ci arrivo: non so' bene come modificarlo per fargli prendere anche i "titoli" delle tabelle...

      Spero qualcuno mi possa aiutare. Grazie

      #8680 Risposta

      vecchio frac
      Moderatore
        35 pts

        Ma se sai a priori che i titoli delle tabelle saranno sempre e soltanto quelli da te indicati, io direi che non ti conviene spulciare il sorgente della pagina html per cercare eventuali tags.

        Io preparerei una mask string con i nomi dei titoli delle tabelle e poi preleverei il nome giusto attraverso il suo indice, definito da KK.

        Option Explicit
        
        Const TITLES as String = "Directed by,Writing Credits,Cast,Produced by,Music by,...continua tu..."
        
        
        ...poi dentro il codice...
        
        KK = 0
        For Each myItm In myColl
            Cells(I + 1, "A").Value = Split(TITLES, ",")(KK)
            KK = KK + 1
            I = I + 1
            For Each trtr In myItm.Rows
        #8688 Risposta
        PippoLogic80
        PippoLogic80
        Partecipante

          Purtroppo sono uguali sempre e solo le prime 3 tabelle (voci), dopo, a volte cambiano; ecco un esempio:

          https://www.imdb.com/title/tt0064116/fullcredits/?ref_=tt_ov_st_sm

          https://www.imdb.com/title/tt2096673/fullcredits/?ref_=tt_ov_st_sm

          dopo il Cast, le voci di mio interesse sono sempre le stesse, ma non sempre nello stesso ordine e a volte ne manca qualcuna; queste quelle che mi interesserebbe prendere: 

          - Directed by (Regia)

          - Writing Credits (Sceneggiatura)

          - Cast 

          - Music by (Musiche)

          - Cinematography by (Fotografia)

          - Film Editing by (Montaggio)

          - Production Companies (Produzione)

          - Distributors (Distribuzione)

          e si trovano in 2 diverse pagine:

          https://www.imdb.com/title/tt2096673/fullcredits/?ref_=tt_ov_st_sm

          https://www.imdb.com/title/tt2096673/companycredits?ref_=ttfc_sa_3

          #8692 Risposta

          vecchio frac
          Moderatore
            35 pts

            PippoLogic80 ha scritto:

            Purtroppo sono uguali sempre e solo le prime 3 tabelle (voci), dopo, a volte cambiano

            Peccato davvero perchè questo complica a dismisura, per quello che vedo, conosco e so posso suggerire un approccio micidiale ma che in teoria può funzionare: leggere l'id "fullcredits_content" (che contiene tutto il contenuto della pagina che ti interessa), quindi scorrere in sequenza i diversi tag "h4 class" che dopo il meta "::before" contengono il testo visualizzato come titolino della singola sezione. Sto esaminando il sorgente con il Chrome inspector (strumenti per sviluppatori, Ctrl-Shift-I) e sinceramente non mi viene in mente niente di meglio.

            #8697 Risposta
            PippoLogic80
            PippoLogic80
            Partecipante

              Capisco quello che intendi.... speriamo che qualcuno abbia fatto qualcosa del genere e posso darmi una dritta. Intanto seguo la tua idea e vedo cosa riesco a costruire.

              Grazie per il momento.

              #8699 Risposta

              vecchio frac
              Moderatore
                35 pts

                Dunque, stasera ho cercato di attuare la mia folle idea...

                Set x = IE.Document.getElementbyID("fullcredits_content")
                v = Split(x.innerhtml, "<h4 class=""dataHeaderWithBorder"">")

                Il primo Set assegna a x l'intero contenuto del corpo della pagina, quella che contiene tra le altre cose anche i titoli delle diverse sezioni che ti interessano.

                La seconda assegnazione alla variabile "v" invece splitta il contenuto che abbiamo appena recuperato in corrispondenza dei marcatori html che identificano il titolino della sezione.

                La cosa è al momento molto brutta e solo abbozzata, però leggendo in sequenza il risultato di ogni elmento in "v" e recuperando solo la prima linea (quella che termina con carriage return per capirci) dovrei esser ein grado di ottenere il testo desiderato. Che poi va ripulito un pochino... vabbè ma è un primo passo.

                Se domani sono un attimo libero faccio una prova concreta.

                By the way, nel tuo codice devi dichiarare le variabili, inserire Option Explicit e fare un'indentazione più coerente altrimenti è un guazzabuglio 🙂

                #8701 Risposta
                PippoLogic80
                PippoLogic80
                Partecipante

                  Grazie vecchio frac, domani la provo anche si.

                  Si, il codice lo devo ripulire e non solo, dovrei anche commentarlo per bene... e di questo avrei bisogno aiuto, in quanto alcuni passaggi mi vengono difficili da capire. Purtroppo ho preso stralci qua e la su internet per arrivare ad abbozzare quello che ho postato.... e con la tua ultima dritta, credo che sia arrivato il tempo di sistemarlo davvero. Chiedo troppo in un aiuto anche in questo? Grazie, notte

                  #8706 Risposta

                  vecchio frac
                  Moderatore
                    35 pts

                    Ti faccio una piccola proposta. Poi il codice si può anche commentare.

                    L'output è probabilmente da pulire, ma mi preme ottenere la tua approvazione prima di rifinire.

                    Option Explicit
                    
                    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
                    
                    Sub GetWebTab2()
                    Dim IE As Object
                    Dim f As Long, myRColl As Variant, myDColl As Variant
                    Dim kk As Long, i As Long, j As Long
                    Dim myColl As Variant
                    Dim my2Coll As Variant
                    Dim myR As Variant, myTD As Variant
                    Dim myItm As Variant
                    Dim myURL As String
                    Dim myStart As Single
                    Dim content As Variant
                    Dim v As Variant
                    Dim trtr As Variant, tdtd As Variant
                    Dim sections() As String
                    Dim dataHeader As Variant, dataHeaders As Variant
                    
                        myURL = "https://www.imdb.com/title/tt0227445/fullcredits?ref_=tt_cl_sm#cast"
                        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
                        
                        Set content = IE.Document.getElementbyID("fullcredits_content")
                        dataHeaders = Split(content.InnerHTML, "<h4 class=""dataHeaderWithBorder"">")
                        
                        i = 0
                        ReDim sections(0) As String
                        For Each dataHeader In dataHeaders
                            v = Split(dataHeader, vbCrLf)(0)
                            sections(i) = Split(v, "</h4>")(0)
                            sections(i) = Replace(sections(i), "&nbsp;", "")
                            sections(i) = Trim(sections(i))
                            i = i + 1
                            ReDim Preserve sections(i) As String
                        Next
                        i = i + 1
                        ReDim Preserve sections(i) As String
                        Application.Goto Sheets("Foglio1").Range("A1")
                        
                        ActiveSheet.UsedRange.Clear
                        
                        i = 0
                        kk = 0
                        Set myColl = IE.Document.getElementsbyTagName("TABLE")
                        For Each myItm In myColl
                            i = i + 1
                            kk = kk + 1
                            Cells(i, "A").Value = "TABELLA_" & kk
                            Cells(i, "D").Value = sections(kk)
                            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
                        
                        'Legge le tabelle dentro gli iframe:
                        kk = 0
                        i = 1
                        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
                                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
                        
                        Range("A1").Select
                        ActiveSheet.UsedRange.WrapText = False
                        
                        IE.Quit
                        Set IE = Nothing
                        
                        MsgBox "Finito!"
                    End Sub
                    
                    #8710 Risposta
                    PippoLogic80
                    PippoLogic80
                    Partecipante

                      Che dire: sei un grande!

                      Anche se il risultato è da pulire, ho tutte le informazioni che mi servono. Sul foglio ci faccio quasi tutto, è dall'esterno che avevo difficoltà.

                      Ho dovuto aggiustare 3 cose;

                      1- da così:

                      Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

                      a così:

                      Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
                      

                      in quanto uso un sistema a 64 bit;

                      2- ho rimosso la dicitura TABELLA e spostato il dato di mio interesse sulla colonna A:

                      `'        Cells(i, "A").Value = "TABELLA_" & kk     <<<<<<rimosso
                      '        Cells(i, "D").Value = sections(kk)         <<<<rimosso
                              Cells(i, "A").Value = sections(kk)
                      

                      3- poi ho cambiato il foglio dall'uno a tre, giusto per applicarlo al progetto in corso.

                      Resta quindi solo un pochino di pulizia e commentare (e su tutte le voci per html, passo). Per quanto riguarda le variabili e diciture varie, puoi utilizzare quelle che ti piacciono di più, essendo parti di codici prese qua e la da internet, ho fatto parecchia confusione.

                      Grazie grazie davvero.

                      #8711 Risposta

                      vecchio frac
                      Moderatore
                        35 pts

                        Ah ecco Sleep, la puoi togliere perchè all'inizio pensavo di sì ma poi non l'ho utilizzata.

                        Ok per il resto. Appena ho un attimo ti descrivo sommariamente il codice, ma in fondo è abbastanza semplice.

                        #8712 Risposta
                        PippoLogic80
                        PippoLogic80
                        Partecipante

                          Ora vorrei complicare leggermente le cose: pensi sia troppo disturbarti ulteriormente per aggiungere una piccola sezione di codice, che faccia estrarre solo le parti di mio interesse in base ai titoli delle tabelle? 

                          In pratica a me interessano solo queste tabelle: 

                          - Directed 

                          - Writing Credits 

                          - Cast 

                          - Music 

                          - Cinematography

                          - Film Editing 

                          Se aggiungo un mio elenco (tipo come quello che mi dicevi in uno dei primi post):

                          Const TITLES as String = "Directed,Writing Credits,Cast,Produced,Music,ecc"

                          e facendogli caricare solo la tabella corrispondente con il TITLES inserito da me?

                          #8713 Risposta
                          PippoLogic80
                          PippoLogic80
                          Partecipante

                            vecchio frac ha scritto:

                            Ah ecco Sleep, la puoi togliere perchè all'inizio pensavo di sì ma poi non l'ho utilizzata.

                            Non conosco la parte che richiama al codice html... mi sarebbe utile una leggere spiegazione per capire come migliorarlo per rendere più efficiente il foglio risultante.

                            vecchio frac ha scritto:

                            Ok per il resto. Appena ho un attimo ti descrivo sommariamente il codice, ma in fondo è abbastanza semplice; dimmi solo se sono sulla giusta strada.

                            Non ho fretta, fai pure con comodo, intanto faccio qualche prova anche io... vediamo se ci riesco; dimmi solo se sono sulla giusta strada.

                            #8715 Risposta

                            vecchio frac
                            Moderatore
                              35 pts

                              Ho semplificato un pochino, togliendo il codice (secondo me inutile) relativo agli iFrames che tanto non veniva eseguito 🙂

                              Anche la gestione dei tag H4, da cui si ricava il titolo di ogni sezione, si poteva ricavare in modo più semplice.

                              Option Explicit
                              
                              
                              Sub GetWebTab2_VF2()
                              Dim IE As Object
                              Dim f As Long
                              Dim kk As Long, i As Long, j As Long
                              Dim myColl As Variant
                              Dim myItm As Variant
                              Dim myURL As String
                              Dim v As Variant
                              Dim trtr As Variant, tdtd As Variant
                              Dim sections As Variant
                              
                                  myURL = "https://www.imdb.com/title/tt0227445/fullcredits?ref_=tt_cl_sm#cast"
                                  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
                                  
                                  Set sections = IE.Document.getElementsbyTagName("H4")
                              
                                  Application.Goto Sheets("Foglio1").Range("A1")
                                  
                                  ActiveSheet.UsedRange.Clear
                                  
                                  i = 0
                                  kk = 0
                                  Set myColl = IE.Document.getElementsbyTagName("TABLE")
                                  For Each myItm In myColl
                                      i = i + 1
                                      Cells(i, "A").Value = sections(kk).innertext
                                      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
                                      kk = kk + 1
                                  Next myItm
                                  
                                  Range("A1").Select
                                  ActiveSheet.UsedRange.WrapText = False
                                  
                                  IE.Quit
                                  Set IE = Nothing
                                  
                                  MsgBox "Finito!"
                              End Sub
                              #8716 Risposta

                              vecchio frac
                              Moderatore
                                35 pts

                                PippoLogic80 ha scritto:

                                Ora vorrei complicare leggermente le cose

                                Non avevo visto questo post... fammici riflettere 🙂

                                #8717 Risposta
                                PippoLogic80
                                PippoLogic80
                                Partecipante

                                  Ci stavo riflettendo.... non ti faccio impazzire più di tanto, creo una sub che applichi un filtro al foglio appena popolato, ripulendo e lasciando solo le cose che mi interessano.

                                  Segno quindi come risolto... se poi ti viene in mente un metodo che faccia estrarre solo i dati di mio interesse, ben venga.

                                  Grazie infinite per il momento.

                                  #8718 Risposta

                                  vecchio frac
                                  Moderatore
                                    35 pts

                                    Come vuoi, però non trovo grosse difficoltà, mi ci stavo già dedicando 🙂

                                    #8720 Risposta
                                    PippoLogic80
                                    PippoLogic80
                                    Partecipante

                                      Allora, se non è troppo disturbo, diventerebbe tutto più pulito, Grazie

                                      #8721 Risposta

                                      vecchio frac
                                      Moderatore
                                        35 pts

                                        Ecco la nuova revisione del codice.

                                        La particolarità è (può piacere oppure no, valuta tu) che se nella costante TITLES metti solo "Cast", viene restituita ogni sezione che contenga "Cast". Altrimenti devi essere preciso e indicare il titolo completo della sezione (ad esempio " Cast (in credits order) verified as complete  ").

                                        Ho aggiunto una funzione "contains" che verifica appunto se una stringa è contenuta in una lista di nomi.

                                        Option Explicit
                                        
                                        Const TITLES As String = "Directed by,Music by,Cast"
                                        
                                        Sub GetWebTab2_VF2()
                                        Dim IE As Object
                                        Dim f As Long
                                        Dim kk As Long, i As Long, j As Long
                                        Dim myColl As Variant
                                        Dim myItm As Variant
                                        Dim myURL As String
                                        Dim v As Variant
                                        Dim trtr As Variant, tdtd As Variant
                                        Dim sections As Variant
                                        
                                            myURL = "https://www.imdb.com/title/tt0227445/fullcredits?ref_=tt_cl_sm#cast"
                                            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
                                            
                                            Set sections = IE.Document.getElementsbyTagName("H4")
                                        
                                            Application.Goto Sheets("Foglio1").Range("A1")
                                            
                                            ActiveSheet.UsedRange.Clear
                                            
                                            i = 0
                                            kk = 0
                                            Set myColl = IE.Document.getElementsbyTagName("TABLE")
                                            For Each myItm In myColl
                                                If contains(TITLES, sections(kk).innertext, ",") Then
                                                    i = i + 1
                                                    Cells(i, "A").Value = sections(kk).innertext
                                                    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
                                                End If
                                                kk = kk + 1
                                            Next myItm
                                            
                                            Range("A1").Select
                                            ActiveSheet.UsedRange.WrapText = False
                                            
                                            IE.Quit
                                            Set IE = Nothing
                                            
                                            MsgBox "Finito!"
                                        End Sub
                                        
                                        
                                        Private Function contains(list As Variant, item As String, Optional delimiter As String = " ") As Boolean
                                        Dim itm As Variant
                                        
                                            If IsMissing(delimiter) Then delimiter = " "
                                            contains = False
                                            For Each itm In Split(list, delimiter)
                                                contains = InStr(LCase(item), LCase(itm))
                                                If contains Then Exit Function
                                            Next
                                            
                                        End Function
                                        
                                        #8722 Risposta
                                        PippoLogic80
                                        PippoLogic80
                                        Partecipante

                                          Ti ringrazio di cuore vecchio frac, così è perfetto. La funzione contains è molto interessante.... 

                                          Credo che così siamo decisamente a posto! Grazie

                                          #8727 Risposta

                                          vecchio frac
                                          Moderatore
                                            35 pts

                                            Appena riesco ti aggiungo un breve commento al codice. Se non rispondo in un paio di giorni fammi un promemoria, perchè la tecnica usata può essere interessante per chiunque voglia leggere il thread 🙂

                                            #8732 Risposta
                                            PippoLogic80
                                            PippoLogic80
                                            Partecipante

                                              vecchio frac ha scritto:

                                              Appena riesco ti aggiungo un breve commento al codice. Se non rispondo in un paio di giorni fammi un promemoria, perchè la tecnica usata può essere interessante per chiunque voglia leggere il thread 🙂

                                              Ok. Io intanto se lo perfeziono e lo adatto al mio scopo, inoltro gli sviluppi. Grazie

                                              #8954 Risposta
                                              PippoLogic80
                                              PippoLogic80
                                              Partecipante

                                                vecchio frac ha scritto:

                                                Appena riesco ti aggiungo un breve commento al codice. Se non rispondo in un paio di giorni fammi un promemoria, perchè la tecnica usata può essere interessante per chiunque voglia leggere il thread 🙂

                                                Solo un promemoria come richiesto. Grazie

                                                #9086 Risposta

                                                vecchio frac
                                                Moderatore
                                                  35 pts

                                                  Grazie a te (anche in privato va bene).

                                                  Non ho avuto ancora occasione di farlo infatti, scusami.

                                                  #9100 Risposta

                                                  vecchio frac
                                                  Moderatore
                                                    35 pts

                                                    Riallego il codice con qualche riga di commento.

                                                    In sostanza la mia proposta si basa fortemente sul tuo approccio iniziale, con il doppio correttivo (riportare i titoli delle sezioni e limitare la ricerca alle sole sezioni specificate).

                                                    Il punto di partenza è impostare un riferimento a un oggetto di tipo applicazione internet, raggiungere con questo la pagina desiderata, assegnarvi il contenuto della stessa e poi, con i metodi propri di tale oggetto, filtrare i tag che separano le varie sezioni del documento (il tag "H4"). Questo l'ho capito esaminando il codice sorgente della pagina internet originale, per fortuna è omogenea e fatta bene 🙂 

                                                    All'interno di ogni sezione si recupera il testo delle diverse tabelle e lo si riporta in Excel, riga per riga.

                                                    HTH

                                                    'la direttiva seguente serve per la dichiarazione obbligatoria delle variabili
                                                    Option Explicit
                                                    
                                                    'la costante TITLES serve da filtro per le sezioni da recuperare
                                                    Const TITLES As String = "Directed by,Music by,Cast"
                                                    
                                                    'scopo della procedura è legegre una pagina internet,
                                                    'recuperare i titoli delle sezioni delle diverse tabelle di cui è composta,
                                                    'leggendone il contenuto e inserendo in Excel
                                                    'il titolo della sezione con il relativo contenuto.
                                                    'E' possibile limitare la lettura delle sezioni desiderate
                                                    'modificando opportunamente la costante TITLES
                                                    
                                                    Sub GetWebTab2_VF2()
                                                    'dichiarazione delle variabili e loro tipizzazione
                                                    Dim IE As Object    ' un oggetto web browser che punta a un sito
                                                    Dim i As Long, j As Long, kk As Long    ' variabili contatori di supporto
                                                    Dim myColl As Variant   ' contiene il contenuto della pagina internet
                                                    Dim myItm As Variant    ' ogni elemento di sezione dentro la pagina internet
                                                    Dim myURL As String     ' indirizzo internet da raggiungere
                                                    Dim trtr As Variant, tdtd As Variant    ' riferimenti alle righe delle tabelle della pagina internet
                                                    Dim sections As Variant ' qui sono contenuti i titoli delle diverse sezioni,
                                                                            ' che poi saranno filtrati dalla costante iniziale
                                                    
                                                        'imposta internet l'indirizzo da raggiungere
                                                        myURL = "https://www.imdb.com/title/tt0227445/fullcredits?ref_=tt_cl_sm#cast"
                                                        'crea l'oggetto internet explorer
                                                        Set IE = CreateObject("InternetExplorer.Application")
                                                    
                                                        'legge il contenuto della pagina internet
                                                        'e lo assegna alla variabile IE
                                                        '(metodo classico)
                                                        With IE
                                                            .Navigate myURL
                                                            .Visible = True
                                                            Do While .Busy: DoEvents: Loop 'Attesa not busy
                                                            Do While .ReadyState <> 4: DoEvents: Loop 'Attesa documento
                                                        End With
                                                        
                                                        'imposta un riferimento all'insieme degli elementi con tag H4 della pagina internet
                                                        Set sections = IE.Document.getElementsbyTagName("H4")
                                                    
                                                        'si posiziona sul foglio Excel desiderato per riversarvi i dati
                                                        'e cancella la zona usata in precedenza
                                                        Application.Goto Sheets("Foglio1").Range("A1")
                                                        ActiveSheet.UsedRange.Clear
                                                        
                                                        'imposta un riferimento all'insieme degli elementi della sezione TABLE del documento
                                                        'e scorre ogni elemento per recuperarne il contenuto desiderato
                                                        'se il testo della sezione è contenuto nella costante TITLES
                                                        'di ogni elemento, poichè è memorizzata come tabella,
                                                        'scorre riga per riga e ne ricava il testo, che inserisce nel foglio Excel
                                                        'in una riga dedicata, indentando a partire dalla colonna A in avanti
                                                        i = 0
                                                        kk = 0
                                                        Set myColl = IE.Document.getElementsbyTagName("TABLE")
                                                        For Each myItm In myColl
                                                            If contains(TITLES, sections(kk).innertext, ",") Then
                                                                i = i + 1
                                                                Cells(i, "A").Value = sections(kk).innertext
                                                                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
                                                            End If
                                                            kk = kk + 1
                                                        Next myItm
                                                        
                                                        'operazioni finali
                                                        Range("A1").Select
                                                        ActiveSheet.UsedRange.WrapText = False
                                                        
                                                        'esce dall'applicazione internet e distrugge l'oggetto in memoria
                                                        IE.Quit
                                                        Set IE = Nothing
                                                        
                                                        MsgBox "Finito!"
                                                    End Sub
                                                    
                                                    
                                                    'la funzione contains determina se un elemento stringa è presente in una lista di elementi,
                                                    'passata anch'essa come stringa in cui gli items sono separati da un delimitatore
                                                    'se non si specifica un delimitatore viene assunto il carattere spazio
                                                    'esempio:
                                                    'contains("uno;due;tre", "due", ";") restituisce TRUE
                                                    'contains("uno;due;tre", "due", ",") restituisce FALSE
                                                    Private Function contains(list As Variant, item As String, Optional delimiter As String = " ") As Boolean
                                                    Dim itm As Variant
                                                    
                                                        contains = False
                                                        For Each itm In Split(list, delimiter)
                                                            contains = InStr(LCase(item), LCase(itm))
                                                            If contains Then Exit Function
                                                        Next
                                                        
                                                    End Function
                                                    
                                                    #9161 Risposta
                                                    PippoLogic80
                                                    PippoLogic80
                                                    Partecipante

                                                      Che dire, tutto molto chiaro, e per un auto-didatta come me, avere commenti così chiari nel codice sono una manna dal cielo per capire bene lo svolgersi degli eventi.

                                                      Spero che questo esempio possa essere d'aiuto anche per altri utenti che vorranno prelevare informazioni mirate da pagine internet analoghe.

                                                      Ti ringrazio davvero tanto.

                                                    Login Registrati
                                                    Stai vedendo 25 articoli - dal 1 a 25 (di 32 totali)
                                                    Rispondi a: Importare dati in tabella da una pagina web conosciuta
                                                    Gli allegati sono permessi solo ad utenti REGISTRATI
                                                    Le tue informazioni:



                                                    vecchio frac - 1100 risposte

                                                    albatros54
                                                    albatros54 - 519 risposte

                                                    patel
                                                    patel - 311 risposte

                                                    Marius44
                                                    Marius44 - 298 risposte

                                                    Luca73
                                                    Luca73 - 270 risposte