Routine Outlook VBA contro Spammisti e scocciatori
NOTA BENE. Questo articolo contiene al termine un aggiornamento relativo a un problema - corpo della replica formattato - che nella versione precedente era in sospeso.
Lo SPAM, ovvero l’e-mail indesiderato proveniente da fonti varie dilaga, intasando la nostra casella di posta in arrivo. Addirittura da ultimo ricevo messaggi (con offerte le più bizzarre e… ingannevoli!) da indirizzi fasulli. Dico io: Ma che ci stanno a fare gli Internet Provider responsabili di gestire questo servizio?
Stufo della faccenda, ho implementato procedure VBA per Outlook atte a rispondere con contumelie ad hoc a siffatti sgradevoli soggetti. In due versioni, accomunate dalla stessa
Modalità di impiego. Si compie in due mosse:
- selezionare – in modo discontinuo (e con la massima attenzione, per evitare risposte a gente innocente) – i messaggi antipatici;
- lanciare la macro – magari associata a un pulsantino di una specifica barra personalizzata.
L’occasione mi è propizia per porgere i miei più distinti saluti ai 25 (e passa) visitatori? Perché no?, però questi esempi mi servono anche a chiarire tipici oggetti della libreria Outlook ai tantissimi individui che non hanno familiarità con tale ambiente, su cui per soprammercato la documentazione e i testi dedicati scarseggiano anzichenò.
Prima soluzione, con UserForm
Diamola al più presto come ricetta. Basta copiarla in un qualche Modulo1 o, volendo, nel modulo ThisOutlookSession tipico di Outlook. Prima però si debbono fare due preparativi:
1) una semplice Userform1, composta da un CommandButton1 con etichetta “Inserisci” e da una TextBox1 (1), quest’ultima abbastanza ampia e – si badi bene! – caratterizzata dalla proprietà Multiline = True, che permette alla casella di testo di ospitare testi abbastanza lunghi (2).
Note
(1) La pigrizia mi fa evitare, nei casi semplici, di perdere tempo con nomi personali. Così uso UserForm1, CommandButton1, TextBox1,… (per eccesso di fantasia). I puristi mi perdonino.
(2) Ricordo a ignari & immemori che per imporre l’a-capo va digitato Ctrl+Invio. Col semplice Invio si esce dalla casella!
2) Un file di attachement, diciamo uno stopspam.jpg, un’immagine in cui ciascuno si può sbizzarrire con propri disegni di proteste & sberleffi.
Ma ecco il codice in questione:
Sub RispondiAUnMess()
'Con inserimento del testo digitato dall'utente
'in una UserForm nel BODY della replica (Reply)
Dim olApp As Outlook.Application
Dim Nms As Outlook.NameSpace
Dim OlExpl As Outlook.Explorer
Set olApp = Outlook.Application
Set Nms = olApp.GetNamespace("MAPI")
Set OlExpl = olApp.ActiveExplorer
Dim OlSel As Outlook.Selection
Dim Mess As String
Dim CartellAttiva As String
Dim iMess As Integer, Mittente As String
CartellAttiva = OlExpl.CurrentFolder.Name
If CartellAttiva <> "Posta in arrivo" Then
Mess = "Questa routine ha senso e funziona" & vbLf & _
"solo se è attiva la Posta in arrivo!"
MsgBox Mess, vbInformation, "Cartella attiva: " & CartellAttiva
Set OlExpl.CurrentFolder = _
Nms.GetDefaultFolder(olFolderInbox)
Exit Sub
End If
Set OlSel = OlExpl.Selection
On Error Resume Next 'Ignora i messaggi privi di mittente
'(es. segnalazioni del provider di utenti sconosciuti)
Load UserForm1
With UserForm1
.TextBox1.Text = ""
.Show
Mess = .TextBox1.Text
'.Hide 'NON serve: già previsto nell'evento Click del pulsante
End With
Unload UserForm1
For iMess = 1 To OlSel.Count
With OlSel.Item(iMess)
Mittente = .SenderName
With .Reply 'Restituisce un messaggio di replica
.Body = "Salve " & Mittente & vbLf & vbLf & Mess
If MsgBox("Mando l'allegato?", vbQuestion + vbYesNo, _
"Invio Attachment") = vbYes Then
.Attachments.Add "C:\Documenti\stopspam.jpg"
End If
.Send
End With
End With
Next iMess
End Sub
Commenti essenziali
Si esordisce impostando (Set) in OlApp, Nms, olExpl e OlSel rispettivamente: l’applicazione Outlook, il suo Namespace, il suo Explorer e la selezione corrente. Va precisato che il Namespace disponibile in Outlook 2003 è uno solo e va sotto il nome “MAPI”. Senza qui scervellarsi sul suo significato concettuale precisiamo – e teniamo a mente – che Nms qui come altrove va impostato con GetNamespace. Centrale, in questi esempietti, sono poi due oggetti:
Ø Selection, che in Outlook comprende tutti gli elementi attualmente selezionati;
Ø ActiveExplorer, che, sempre in Outlook, è, come dire, un Cicerone che dà accesso a diverse parti del sistema di posta; Il nostro codice lo fissa nella variabile OlExpl.
Quindi OlExpl.CurrentFolder fornisce la cartella (Folder) attiva. Qui va detto ai (molti…) neofiti di Outlook VBA che esso è appunto suddiviso in tanti Folder, relativi alla Posta in arrivo, a quella inviata, ai Contatti e via di seguito. Il programmetto prosegue con una verificando il nome della CartellaAttiva fornita da:
OlApp.ActiveExplorer.CurrentFordel.Name
Se tale nome è diverso da “Posta in arrivo”, l’unica in cui questa procedura ha senso, il codice chiarisce la cosa e provvede ad attivare la cartella giusta. Lo fa impostando l’olExpl.CurrentFolder, sfruttando il metodo specifico del Namespace “MAPI”, ossia GetDefaultFolder con argomento olFolderInbox (Inbox, in inglese è la casella di posta in arrivo, ma come avete fatto a indovinare?). Poi la procedura se ne esce (Exiit Sub), visto che di primo acchito in tale cartella non è selezionato un bel niente. A quel punto l’utente provvede a selezionare i messaggi sgraditi e rilancia la Sub, che stavolta procede col lavoro normale. Questo inizia impostando la selezione corrente in olSel e caricando la UserForm, il cui contenuto della TextBox1 è acquisito nella variabile Mess (su altri particolari progettuali della UserForm, v. più avanti) poi ha inizio un ciclo che spazzola gli olSel.Count elementi della selezione (olSel.item(iMess)) elaborando per ciascuno la proprietà Reply, che è la replica all’odiato messaggio, inserendo nel corpo (Body) della replica le contumelie digitate, precedute da “Salve” più il nome del mittente (Sender). Segue infine la richiesta di mandare o meno l’allegato, che su risposta affermativa viene inserito col metodo Attachments.Add , sempre inerente all’oggetto Reply.
Note sulla UserForm
Ecco le routine cruciali della UserForm1:
Private Sub UserForm_Initialize()
With TextBox1
.Text = "" 'In realtà serve poco...
.SetFocus
End With
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Cancel = 1
End Sub
Private Sub CommandButton1_Click()
If TextBox1.Text = "" Then
MsgBox "DEVI inserire qualcosa...", vbCritical, "Attenzione!"
TextBox1.SetFocus
Else
Me.Hide
End If
End Sub
Due i commento degni… di nota. Il primo è relativo alla seconda procedura, in cui Cancel = 1 fa sì che la form non possa essere chiusa con Esc, Alt+F4 né cliccando sull’icona “x”. Quando a quella del pulsante, palesemente essa costringe l’utente a digitare qualcosa.
Seconda soluzione, con testo attinto da un documento Word
Anche qui la ricetta si può copiare in un qualche Modulo1 o, volendo, nel modulo ThisOutlookSession tipico di Outlook. Per amore di varietà ho previsto una routine con argomento PercorsoDoc, che ho concretamente sfruttato con la Sub RispATuttiMess posta subito sotto.
Sub RispondiAUnMessaggio(PercorsoDoc As String)
'Con inserimento del testo di un documento
'Word nel BODY della replica (Reply)
Dim Nms As Outlook.NameSpace
Set Nms = Application.GetNamespace("MAPI")
Dim OlSel As Outlook.Selection
Dim Mess As String
Dim CartellAttiva As String
Dim iMess As Integer, Mittente As String
CartellAttiva = ActiveExplorer.CurrentFolder.Name
If CartellAttiva <> "Posta in arrivo" Then
Mess = "Questa routine ha senso e funziona" & vbLf & _
"solo se è attiva la Posta in arrivo!"
MsgBox Mess, vbInformation, "Cartella attiva: " & CartellAttiva
Set ActiveExplorer.CurrentFolder = _
Nms.GetDefaultFolder(olFolderInbox)
Exit Sub
End If
Set OlSel = ActiveExplorer.Selection
On Error Resume Next 'Ignora i messaggi privi di mittente
'(es. segnalazioni del provider di utenti sconosciuti)
Dim WordDoc As Word.Document, TestoDoc As String
Set WordDoc = GetObject(PercorsoDoc)
With WordDoc
.Select
TestoDoc = Selection
.Close
.Parent.Quit
End With
Set WordDoc = Nothing
For iMess = 1 To OlSel.Count
With OlSel.Item(iMess)
Mittente = .SenderName
With .Reply 'Restituisce un messaggio di replica
.Body = "Hi " & Mittente & vbLf & vbLf & TestoDoc
If MsgBox("Mando l'allegato?", vbQuestion + vbYesNo, _
"Invio Attachment") = vbYes Then .Attachments.Add _
"C:\Documenti\ stopspam.jpg"
End If
.Send
End With
End With
Next iMess
Set OlSel = Nothing: Set Nms = Nothing
End Sub
Sub RispATuttiMess()
RispondiAUnMessaggio PercorsoDoc:= _
"C:\Documenti\StopSpam.doc"
End Sub
Commenti essenziali
Stavolta sono essenziali per davvero, in quanto la prima parte e l’ultima parte sono identiche a quelle della prima soluzione. Si noti solo che abbiamo rinunciato alle pignolerie del tipo Set olApp = Outlook.Application. Questo per il semplice motivo che, operando in ambiente Outlook, l’oggetto Application è univocamente individuato. Idem con patate lesse per ActiveExplorer.
La variante, annunciata, sostituisce alla UserForm un file Word il cui pathname completo viene passato a RispondiAUnMessaggio. Il codice cruciale, che forma la variante, lo riporto nuovamente qui sotto, per comodità:
Set WordDoc = GetObject(PercorsoDoc)
With WordDoc
.Select
TestoDoc = Selection
.Close
.Parent.Quit
End With
Set WordDoc = Nothing
Si fa ricorso alla OLE Automation con la funzione GetObject , che nella fattispecie acquisisce in WordDoc il documento con la protesta standard. Poi questo viene selezionato e tale selezione è acquisita in TestoDoc. Si conclude con la chiusura del documento e del suo Parent (Word).
Nota – Si ricorda che tutte queste operazioni avvengono nell’ombra (background): né Word, né tantomeno il documento vengono visualizzati.
Il cerchio si chiude con questa istruzione, da confrontare con la corrispondente di prima:
With .Reply 'Restituisce un messaggio di replica
.Body = "Hi " & Mittente & vbLf & vbLf & TestoDoc
Una sfida irrisolta
C’è un’ultima cosa da dire. Come i più interessati potranno sperimentare, l’istruzione predetta NON acquisisce formati dell’originale (grassetti, corsivi, colori ecc.), ma soltanto testo. La cosa in prima battuta può stupire, in quanto se si copia negli appunti materiale selezionato manualmente poi lo si incolla, sempre manualmente (Ctrl+V) nel corpo di un messaggio tutti i formati vengono fedelmente trascritti. A una condizione, ossia che venga preliminarmente fissato il formato RTF o HTML.
Come mai qui la cosa non funziona? Ho avuto una discussione con un esperto che sosteneva esserci una possibilità (o scappatoia? Non ho capito bene). Ma sembrerebbe che non ci sia scampo, per un motivo concettuale:
La proprietà Body accetta solo stringhe; e la cosa è confermata dal fatto che persino impostando la proprietà E non serve a nulla premettere la proprietà BodyFormat = olFormatRichText o olFormatHTML.
Temendo che non ci fossero alternative, avevo invitato chi le trovasse a fare un fischio…
Pensa e ripensa… ecco una soluzione parziale
Per farla breve, trattasi di un ripiego, espresso anzitutto da una routine del tipo seguente:
Sub BodyFormattato()
Dim WordDoc As Word.Document, TestoDoc As String
Set WordDoc = _
GetObject("C:\Documenti\StopSpam.doc")
With WordDoc
.Select
Selection.Copy
.Close
'.Parent.Quit 'QUI DA' ERRORE, DIO SA PERCHE'...
End With
Set WordDoc = Nothing
Dim MioMess As MailItem
Set MioMess = Application.CreateItem(olMailItem)
'Istruzione facoltativa (promemoria all’utente):
'MsgBox "Ctrl+V per inserire testo formattato"
With MioMess
.BodyFormat = olFormatRichText 'Imposta il formato RTF
.To = ""
.Body = " "
.Display 'Mostra la letterina, senza ancora spedirla
End With
ActiveDocument.Range.Paste
Set MioMess = Nothing
End Sub
La scappatoia, come gran parte degl’interessati dovrebbero comprendere, consiste nell’istruzione semifinale ActiveDocument.Range.Paste che agisce nel documento attivo, ove adesso in ballo c’è Word.
Approfittando di questa scoperta, ecco poi una Sub che la applica a un messaggio “replicato”, ovvero che sfrutta il metodo Reply:
Nota – Invito a studiare, e sperimentare, anche ReplyAll...
Sub RispAunMessFormattato()
'Con inserimento del testo di un documento
'Word nel BODY della replica (Reply)
Dim Nms As Outlook.NameSpace
Set Nms = Application.GetNamespace("MAPI")
Dim OlSel As Outlook.Selection
Dim Mess As String, PercorsoAllegati As String
PercorsoAllegati = "C:\Documenti\"
Dim CartellAttiva As String
Dim iMess As Integer, Mittente As String
CartellAttiva = ActiveExplorer.CurrentFolder.Name
If CartellAttiva <> "Posta in arrivo" Then
Mess = "Questa routine ha senso e funziona" & vbLf & _
"solo se è attiva la Posta in arrivo!"
MsgBox Mess, vbInformation, "Cartella attiva: " & CartellAttiva
Set ActiveExplorer.CurrentFolder = _
Nms.GetDefaultFolder(olFolderInbox)
Exit Sub
End If
Set OlSel = ActiveExplorer.Selection
On Error Resume Next 'Ignora i messaggi privi di mittente
'(es. segnalazioni del provider di utenti sconosciuti)
Dim WordDoc As Word.Document, TestoDoc As String
Set WordDoc = _
GetObject(PercorsoAllegati & "StopSpam.doc")
With WordDoc
.Select
Selection.Copy
.Close
.Parent.Quit
End With
Set WordDoc = Nothing
With OlSel.Item(1) 'Risposta a un solo messaggio, per semplicità
Mittente = .SenderName
With .Reply 'Restituisce un messaggio di replica
'.Body = "Hi " & Mittente & vbLf & vbLf & TestoDocSet
.BodyFormat = olFormatRichText
.Display
'Chiedi all’utente se vuol spedire
If Msgbox("Vuoi che spedisco il messaggio", VbYesNo) = VbYes Then
.Send
End If
End With
End With
Set OlSel = Nothing: Set Nms = Nothing
End Sub
Se mi è permessa un po’ di propaganda, segnalerei infine a quanti apprezzano questi miei interventi e desiderano approfondire le macro di Office il mio manuale:
Gianni Giaccaglini
“EXCEL E OFFICE VBA”
Editore Hoepli (www.hoepli.it)
Pagg. 594 + CD con numerosi modelli
Euro 40,00
?>
?>