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

Login Registrati
Stai vedendo 25 articoli - dal 1 a 25 (di 38 totali)
  • Autore
    Articoli
  • #8676 Score: 0 | Risposta

    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 Score: 1 | Risposta

    vecchio frac
    Senior Moderator
      238 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 Score: 0 | Risposta

      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 Score: 0 | Risposta

      vecchio frac
      Senior Moderator
        238 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 Score: 0 | Risposta

        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 Score: 1 | Risposta

        vecchio frac
        Senior Moderator
          238 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 Score: 0 | Risposta

          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 Score: 1 | Risposta

          vecchio frac
          Senior Moderator
            238 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 Score: 0 | Risposta

            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 Score: 1 | Risposta

            vecchio frac
            Senior Moderator
              238 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 Score: 0 | Risposta

              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 Score: 0 | Risposta

              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 Score: 1 | Risposta

              vecchio frac
              Senior Moderator
                238 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 Score: 0 | Risposta

                vecchio frac
                Senior Moderator
                  238 pts

                  PippoLogic80 ha scritto:

                  Ora vorrei complicare leggermente le cose

                  Non avevo visto questo post... fammici riflettere 🙂

                  #8717 Score: 0 | Risposta

                  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 Score: 0 | Risposta

                  vecchio frac
                  Senior Moderator
                    238 pts

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

                    #8720 Score: 0 | Risposta

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

                    #8721 Score: 1 | Risposta

                    vecchio frac
                    Senior Moderator
                      238 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 Score: 0 | Risposta

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

                      Credo che così siamo decisamente a posto! Grazie

                      #8727 Score: 0 | Risposta

                      vecchio frac
                      Senior Moderator
                        238 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 Score: 0 | Risposta

                        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 Score: 0 | Risposta

                        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 Score: 0 | Risposta

                        vecchio frac
                        Senior Moderator
                          238 pts

                          Grazie a te (anche in privato va bene).

                          Non ho avuto ancora occasione di farlo infatti, scusami.

                          #9100 Score: 1 | Risposta

                          vecchio frac
                          Senior Moderator
                            238 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 Score: 0 | Risposta

                            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 38 totali)
                          Rispondi a: Importare dati in tabella excel da una pagina web
                          Gli allegati sono permessi solo ad utenti REGISTRATI
                          Le tue informazioni: