Mi sono imbattuto nell’esigenza di dover estrarre degli indirizzi email da un sitoweb che però li contiene in pagina diverse e non tutti in un’unica pagina!

Nella fattispecie si trattava di indirizzi email dei cari Comuni Italiani

Ho cercato siti web che potessero dare tale informazione ed alla fine ho optato per il sito http://www.comuni-italiani.it

Perchè ho scelto quel sito piuttosto che un’altro?

Ho scelto tale sito perchè ho notato che c’era un criterio ben preciso per identificare la scheda di ogni Comune e quindi poterne prelevare le informazioni che necessito.
Mi spiego meglio, cliccando su un qualunque Comune ho notato che l’indirizzo della pagina web riportava sempre il CODICE ISTAT del COMUNE!

Es. http://www.comuni-italiani.it/058/009/index.html

Siccome avevo già una lista dei Comuni Italiani con i rispettivi dati ISTAT e altre utili informazioni (http://ckan.ancitel.it/dataset/comuni-italiani-dati-territoriali-e-demografici)

La lista dei Comuni l’ho messa in un file EXCEL dove poi ho inserito una colonna nuova chiamata EMAIL ed una nuova chiamata ISTATURL

Nella prima cella della colonna ISTATURL ho messo la seguente formala :  =TESTO(SINISTRA(C2;LUNGHEZZA(C2)-3);”000″)&”/”&DESTRA(C2; 3)

Cosa fa esattamente la formula?

La formula non fa altro che andare a prendere il valore nella colonna C2 (codice istat) e creare una parta della stringa che mi occorre nel codice VBA per automatizzare l’estrazione seguendo il criterio utilizzato dal sito stesso per nominare le pagina di ogni COMUNE.

Il codice ISTAT come nell’esempio sopra (http://www.comuni-italiani.it/058/009/index.html) è formato da 3 cifre , uno slash e altre tre cifre

La formula indicata sopra serve quindi a ricreare lo stesso criterio utilizzato dal sito e laddove il primo gruppo abbia meno di 3 cifre, aggiunge automaticamente gli zeri necessari per raggiungere le tre cifre.

Ho quindi inserito nel codice del foglio excel il codice sottostante che esegue le seguenti operazioni :

  • compone l’url secondo il criterio del codice ISTAT
  • esplora la pagina in formato HTML alla ricerca di un indirizzo email
  • quando trova l’indirizzo email controlla che non si tratti dell’indirizzo info@comuni-italiani.it (questo compare quando al Comune non è associato un indirizzo email)
  • nel caso in cui non trova un indirizzo email per tale Comune, salta al prossimo Comune e ripete il controllo
  • se trova l’indirizzo email, lo scrive nella riga corrispondente al Comune in modo tale da compilare la tabella integrando l’indirizzo email che prima non avevamo!

 

Codice :

Sub GetEmail()
  Dim ie As Object, WebText As String, Email As String
  
  Dim righe As Integer
  Dim codiceistat As String
  Dim URL As String
  Dim valoreCella As String
 
  
  'conto le righe nel foglio e le memorizzo in variabile RIGHE
  righe = Sheets("Comuni").UsedRange.Rows.Count
  
  'parto dalla riga due in quanto nella 1 ci sono le intestazioni di colonna che non mi interessano
  riga = Sheets("macro").Range("B2").Value
  If riga = "" Then riga = 2
  
  'ripeto n volte quanto sono le righe nel foglio di excel
  Do Until riga > righe
  
    valoreCella = Sheets("Comuni").Range("B" & riga).Value
    If (valoreCella = "") Then
        
        'formo il codice istat da usare nella query web
        codiceistat = Sheets("Comuni").Range("D" & riga).Value
        URL = "http://www.comuni-italiani.it/" & codiceistat & "/index.html"
        
        Set ie = CreateObject("InternetExplorer.Application")
        ie.navigate URL
        While ie.readyState <> 4
          DoEvents
        Wend
        WebText = ie.document.body.innerhtml
        ie.Quit
        Set ie = Nothing
        Email = GetEmailAddress(WebText)
        
        'se trovo l'indirizzo email sottostante non faccio nulla in quanto significa che per tale Comune non ho trovato un indirizzo
        'email e l'automatismo ha trovato quello del sito da cui sto prelevando i dati.
        
        If Email <> "info@comuni-italiani.it" Then
            Sheets("Comuni").Range("B" & riga).Value = Email
            
        End If
     End If
        'incremento di 1 in modo tale da avanzare nelle righe
        riga = riga + 1
        Set ie = Nothing
  Loop
End Sub

'cerco l'indirizzo email e quando lo trovo lo inserisco in una variabile chiamata Email
Function GetEmailAddress(ByVal S As String) As String
  Dim X As Long, AtSign As Long
  Dim Locale As String, Domain As String
  Locale = "[A-Za-z0-9.!#$%&'*/=?^_`{|}~+-]"
  Domain = "[A-Za-z0-9._-]"
  AtSign = InStr(S, "@")
  If AtSign = 0 Then Exit Function
  For X = AtSign To 1 Step -1
    If Not Mid(" " & S, X, 1) Like Locale Then
      S = Mid(S, X)
      If Left(S, 1) = "." Then S = Mid(S, 2)
      Exit For
    End If
  Next
  AtSign = InStr(S, "@")
  For X = AtSign + 1 To Len(S) + 1
    If Not Mid(S & " ", X, 1) Like Domain Then
      S = Left(S, X - 1)
      If Right(S, 1) = "." Then S = Left(S, Len(S) - 1)
      GetEmailAddress = S
      Exit For
    End If
  Next
End Function

Ovviamente il tutto andrà alla velocità con cui il sito restituisce le pagine ed influenzato dal tempo di elaborazione delle pagina da parte del codice, ma almeno non lo devo fare a mano e spaccarmi gli occhi guardando 8000 pagine!

Il codice VBA è stato trovato sul web e modificato secondo le mie esigenze. Non ricordo l’autore.

Categorie: Excel

0 commenti

Lascia un commento