Invio di una e-mail utilizzando un server remoto con CDO
Il funzionamento di un servizio di posta elettronica è garantito dalla collaborazione
di tre distinti software: un server che si occupa della consegna dei messaggi (protocollo SMTP), un server che riceve i messaggi, li archivia e li trasmette, su richiesta, al titolare della casella (protocollo POP3 o IMAP) e un client che, dal PC dell'utente, è in grado di inviare e ricevere e-mail collegandosi e dialogando con le due parti server del servizio. I Web server non offrono funzionalità di posta elettronica, tuttavia le macchine che ospitano servizi Web, spesso e volentieri, permettono anche l'invio delle e-mail, tramite un apposito server SMTP.
A partire dalla versione Windows NT/2000, è stata integrata una libreria COM, chiamata
CDO, che è l’acronimo di
Collaboration Data Object, contenuta nel file Cdosys.dll, e permette di spedire e-mail attraverso il protocollo SMTP (Simple Mail Transfert Protocol) del Sistema Operativo, senza alcun bisogno di utilizzare un client. Vedremo come è possibile sfruttare il server SMPT presente nel sistema per inviare e-mail generate dinamicamente aiutandoci con qualche esempio.
Esempio 1: Inviare una e-mail utilizzando Gmail.
Per poter utilizzare gli oggetti della libreria CDO è innanzitutto indispensabile istanziare tali oggetti. In questo esempio useremo solo l’oggetto
CDO.Message in cui verrà definito il messaggio stesso e per istanziare l’oggetto useremo il comando:
Set cdoMess = CreateObject("CDO.message"). La routine completa è la seguente
Codice:
Sub inviaE()
'istanza dell'oggetto CDO
Set cdoMess = CreateObject("CDO.message")
'Impostare i parametri di configurazione del server remoto
With cdoMess.Configuration.Fields
‘Indicare come il messaggio deve essere inviato. I valori sono:
‘1 – Si utilizza questo valore se il servizio SMTP è installato nel computer in cui lo script è in esecuzione.
‘2 – Si utilizza questo valore se il servizio SMTP non è installato nel computer in cui lo script è in esecuzione.
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Impostare il server SMTP che si utilizza
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
'Impostare la porta di comunicazione del server SMTP
.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 587
'Abilitare autenticazione SMTP, il valore 1 indica True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
‘Abilita autenticazione SSL
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
‘Timeout di connessione in secondi (il tempo massimo in cui CDO tenterà di stabilire una connessione al server SMTP
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
'Impostare le credenziali del vostro account Gmail
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "prova@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "pass1234"
'Aggiorna i campi di configurazione
.Update
End With
’Proprietà del messaggio
With cdoMess
‘Inserire l’indirizzo del destinatario. E’ possibile inserire più indirizzi separandoli con una virgola
.To = info.prova@gmail.com
‘Inserire il nominativo del mittente della e-mail
.From = prova@gmail.com
‘Inserire l'oggetto della e-mail
.Subject = "Invio email con CDO"
‘Inserire il corpo della email in testo semplice
.TextBody = "Inserire il corpo del messaggio." & vbCRLF & "Si consiglia di creare una variabile per contenere tutto il testo"
‘Spedizione della mail
.Send
End With
Set cdoMess = Nothing
End Sub
Il codice sopra riportato è ampiamente commentato e non serve aggiungere ulteriori spiegazioni, possiamo però perfezionare il codice aggiungendo altri parametri. Per esempio, supponiamo di avere i dati di spedizione della mail in un foglio di lavoro denominato “Setup” e di doverli recuperare in automatico.
Fig. 1
In questi casi sarebbe opportuno dividere la procedura in 2 routine, in cui una si occupa di recuperare i dati presenti nel foglio di lavoro e passarli alla seconda che li processerà e invierà l’email. Per recuperare i dati dal foglio “Setup” possiamo usare un codice come il seguente:
Codice:
Sub Prova()
Dim Eto As String, Efrom As String, Eogg As String, Emess As String, Esmtp As String, Epass As String
Eto = Sheets("setup").Range("B2")
Efrom = Sheets("setup").Range("B1")
Eogg = Sheets("setup").Range("B3")
Emess = Sheets("setup").Range("B4")
Esmtp = Sheets("setup").Range("B5")
Epass = Sheets("setup").Range("B6")
inviaE Eto, Efrom, Eogg, Emess, Esmtp, Epass
End Sub
Mentre la routine che invierà la mail presenterà questo codice
Codice:
Sub inviaE(Eto As String, Efrom As String, Eogg As String, Emess As String, Esmtp As String, Epass As String)
'istanza dell'oggetto CDO
Set cdoMess = CreateObject("CDO.message")
With cdoMess.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Esmtp
.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 587
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Efrom
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Epass
.Update
End With
With cdoMess
.To = Eto
.From = Efrom
.Subject = Eogg
.TextBody = Emess
.Send
End With
Set cdoMess = Nothing
End Sub
Possiamo anche allegare uno o più file al messaggio modificando il ciclo With in questo modo:
Codice:
With cdoMess
.To = Eto
.From = Efrom
.Subject = Eogg
.TextBody = Emess
.AddAttachment "C:\Test\info.txt"
.Send
End With
Oppure inserire il percorso nel foglio “Setup” e allegarlo sotto forma di variabile come visto in precedenza.
A volte può presentarsi la necessità di dover spedire delle email con un testo standard, può essere una promozione di certi prodotti, oppure un avviso qualsiasi, in questi casi è possibile inserire il testo presente in un file nel corpo della mail in questo modo:
Codice:
'Queste costanti sono definite per rendere il codice più leggibile
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
'Aprire il file in lettura
Set f = fso.OpenTextFile("C:\Test\annuncio.txt", ForReading)
'Il metodo ReadAll legge l'intero file nella variabile BodyText
BodyText = f.ReadAll
'Chiudi il file
f.Close
Set f = Nothing
Set fso = Nothing
With cdoMess
.To = Eto
.From = Efrom
.Subject = Eogg
.TextBody = BodyText
.Send
End With
Set cdoMess = Nothing
End Sub
Il codice sopra riportato mostra come leggere il contenuto di un file (annuncio.txt) e inserirlo in una variabile (BodyText) che costituirà il corpo del messaggio. La routine completa in questo caso diventa:
Codice:
Sub inviaE(Eto As String, Efrom As String, Eogg As String, Emess As String, Esmtp As String, Epass As String)
'istanza dell'oggetto CDO
Set cdoMess = CreateObject("CDO.message")
With cdoMess.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Esmtp
.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 587
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Efrom
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Epass
.Update
End With
'Queste costanti sono definite per rendere il codice più leggibile
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
'Aprire il file in lettura
Set f = fso.OpenTextFile("C:\Test\annuncio.txt", ForReading)
'Il metodo ReadAll legge l'intero file nella variabile BodyText
BodyText = f.ReadAll
'Chiudi il file
f.Close
Set f = Nothing
Set fso = Nothing
With cdoMess
.To = Eto
.From = Efrom
.Subject = Eogg
.TextBody = BodyText
.Send
End With
Set cdoMess = Nothing
End Sub
Sub Prova()
Dim Eto As String, Efrom As String, Eogg As String, Emess As String, Esmtp As String, Epass As String
Eto = Sheets("setup").Range("B2")
Efrom = Sheets("setup").Range("B1")
Eogg = Sheets("setup").Range("B3")
Emess = Sheets("setup").Range("B4")
Esmtp = Sheets("setup").Range("B5")
Epass = Sheets("setup").Range("B6")
inviaE Eto, Efrom, Eogg, Emess, Esmtp, Epass
End Sub
A questo punto si dovrebbe aggiungere al codice una corretta gestione degli errori per evitare e prevenire errori quando la routine è in esecuzione. Possiamo modificare il listato come di seguito riportato
Codice:
Sub inviaE(Eto As String, Efrom As String, Eogg As String, Emess As String, Esmtp As String, Epass As String)
'istanza dell'oggetto CDO
Set cdoMess = CreateObject("CDO.message")
'Gestione errori
On Error GoTo err
With cdoMess.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = Esmtp
.Item("http://schemas.microsoft.com/cdo/configuration/smptserverport") = 587
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Efrom
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Epass
.Update
End With
'Queste costanti sono definite per rendere il codice più leggibile
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
[COLOR="green"]'Aprire il file in lettura
Set f = fso.OpenTextFile("C:\Test\annuncio.txt", ForReading)
'Il metodo ReadAll legge l'intero file nella variabile BodyText
BodyText = f.ReadAll
'Chiudi il file
f.Close
Set f = Nothing
Set fso = Nothing
With cdoMess
.To = Eto
.From = Efrom
.Subject = Eogg
.TextBody = BodyText
.Send
End With
Set cdoMess = Nothing
err:
If err.Number = 53 Then
MsgBox "Manca il file da allegare. Procedura terminata"
Exit Sub
End If
End Sub
Sub Prova()
Dim Eto As String, Efrom As String, Eogg As String, Emess As String, Esmtp As String, Epass As String
'controllo se esiste il destinatario
If Trim(Sheets("setup").Range("B2")) = "" Then
MsgBox "Manca Il Destinatario"
Exit Sub
Else
Eto = Sheets("setup").Range("B2")
End If
'controllo se esiste il mittente
If Trim(Sheets("setup").Range("B1")) = "" Then
MsgBox "Manca Il Mittente"
Exit Sub
Else
Efrom = Sheets("setup").Range("B1")
End If
'controllo è stato inserito l'oggetto della mail
If Trim(Sheets("setup").Range("B3")) = "" Then
MsgBox "Manca L'Oggetto della Mail"
Exit Sub
Else
Eogg = Sheets("setup").Range("B3")
End If
Emess = Sheets("setup").Range("B4")
'controllo se ci sono i dati dell'smtp
If Trim(Sheets("setup").Range("B5")) = "" Then
MsgBox "Manca SMTP da usare"
Exit Sub
Else
Esmtp = Sheets("setup").Range("B5")
End If
'controllo se c'è la password per l'smtp
If Trim(Sheets("setup").Range("B6")) = "" Then
MsgBox "Manca la password dell'SMTP da usare"
Exit Sub
Else
Epass = Sheets("setup").Range("B6")
End If
inviaE Eto, Efrom, Eogg, Emess, Esmtp, Epass
End Sub