MS Outlook: Aggiungere automaticamente i contatti da un'email quando si risponde

Nell’attività quotidiana di un professionista IT o di un knowledge worker, la gestione dei contatti è un aspetto cruciale. Ogni giorno vengono scambiate centinaia di email, spesso con interlocutori che non sono ancora presenti nella rubrica di Outlook. In questi casi, il rischio è quello di perdere tempo nel reinserire manualmente i dati o, peggio, non riuscire a recuperare in futuro un indirizzo di posta elettronica utile.

Microsoft Outlook, pur essendo una delle piattaforme di posta elettronica più diffuse in ambito aziendale, non offre di default una funzionalità che consenta di aggiungere automaticamente i contatti quando si risponde a un’email. Per sopperire a questa mancanza è possibile implementare una macro VBA (Visual Basic for Applications), che permette di automatizzare l’inserimento dei contatti direttamente all’interno di Outlook.

Attraverso una semplice macro VBA è possibile configurare Outlook in modo che, ogni volta che si risponde a un messaggio, il mittente e tutti i destinatari vengano automaticamente salvati nella cartella contatti predefinita.

Procedura operativa:

• Aprire l’editor VBA: premere Alt+F11 per accedere a Microsoft Visual Basic for Applications.
• Accedere al progetto di Outlook: nel riquadro laterale espandere Project1 e fare doppio clic su ThisOutlookSession.
• Copiare il seguente codice VBA e incollarlo nella finestra di codice. Numerosi commenti rendono il codice ben documentato e facilmente leggibile

Option Explicit
' Istruzione fondamentale: richiede che TUTTE le variabili siano dichiarate prima di essere usate.
' Questo aiuta a prevenire errori di battitura (bug) nel codice.

' --- DICHIARAZIONI GLOBALI (a livello di modulo) ---

Public WithEvents xExplorer As Outlook.Explorer
' Dichiara una variabile 'xExplorer' che rappresenta la finestra principale di Outlook
' (dove vedi la lista delle email). 'WithEvents' permette di "ascoltare" cosa succede in quella finestra.

Public WithEvents xMailItem As Outlook.MailItem
' Dichiara una variabile 'xMailItem' che rappresenta l'email che è attualmente selezionata.
' 'WithEvents' ci permette di "ascoltare" l'azione "Rispondi" su quell'email specifica.

' --- GESTIONE AVVIO APPLICAZIONE ---

Sub Application_Startup()
    ' Questa funzione viene eseguita automaticamente non appena apri Outlook.
    Set xExplorer = Outlook.Application.ActiveExplorer
    ' Assegna alla variabile 'xExplorer' la finestra di Outlook attualmente attiva.
End Sub

' --- GESTIONE SELEZIONE (Monitora il cambio di email) ---

Private Sub xExplorer_SelectionChange()
    ' Questa funzione viene eseguita ogni volta che cambi la selezione nella lista delle email.
    
    ' Nota: il codice originale conteneva una riga "Call ReplySelectedMail(xExplorer)" che è stata rimossa
    ' o sostituita dal blocco seguente, che è la versione pulita per assegnare l'oggetto.
    
    On Error Resume Next
    ' Istruzione temporanea: se si verifica un errore (es. selezioni qualcosa che non è un'email),
    ' ignora l'errore e passa alla riga successiva. Necessario qui perché la selezione può essere complessa.
    
    If xExplorer.Selection.Count = 1 Then
        ' Controlla: se hai selezionato un SOLO elemento...
        If TypeOf xExplorer.Selection.Item(1) Is Outlook.MailItem Then
            ' E se quell'elemento è un'Email (MailItem)...
            Set xMailItem = xExplorer.Selection.Item(1)
            ' ...allora assegna quell'email alla variabile 'xMailItem' per poter intercettare il 'Reply'.
        Else
            Set xMailItem = Nothing
            ' Altrimenti, se hai selezionato un calendario o una cartella, rilascia la variabile.
        End If
    Else
        Set xMailItem = Nothing
        ' Se hai selezionato più di un elemento o nessuno, rilascia la variabile.
    End If
    
    On Error GoTo 0
    ' Disattiva l'istruzione temporanea di gestione degli errori per le righe successive.
End Sub

' --- AZIONE PRINCIPALE: L'EVENTO "RISPONDI" ---

Private Sub xMailItem_Reply(ByVal Response As Object, Cancel As Boolean)
    ' Questa funzione viene eseguita solo quando premi il pulsante "Rispondi"
    ' sull'email che è stata selezionata.

    ' --- DICHIARAZIONE VARIABILI LOCALI ---
    Dim xNameSpace As Outlook.NameSpace         ' Per accedere alle cartelle di Outlook (es. Contatti).
    Dim xContactItems As Outlook.Items          ' L'intera collezione di elementi nella cartella Contatti.
    Dim xContact As Outlook.ContactItem         ' Un contatto esistente trovato.
    Dim xNewContact As Outlook.ContactItem      ' Un nuovo contatto da creare.
    Dim xRecipients As Outlook.Recipients       ' La lista di destinatari (A:, Cc:, Ccn:).
    Dim xRecipient As Outlook.Recipient         ' Un singolo destinatario della lista.
    Dim xDictAddresses As Object                ' Strumento avanzato (Dizionario) per tenere traccia
                                                ' degli indirizzi già visti ed evitare duplicati.
    Dim xAddress As Variant                     ' Usato per scorrere gli indirizzi nel Dizionario.
    Dim sName As String                         ' Nome della persona (Mittente o Destinatario).
    Dim sAddress As String                      ' Indirizzo email.
    Dim sFilterAddress As String                ' La stringa di ricerca per trovare i contatti esistenti.
    Dim lIdx As Long                            ' Un contatore per i cicli.

    ' --- 1. PREPARAZIONE E RACCOLTA INDIRIZZI ---

    Set xDictAddresses = CreateObject("Scripting.Dictionary")
    ' Crea il Dizionario (uno strumento per archiviare indirizzi unici: "Indirizzo" -> "Nome").
    
    ' A. Aggiungi il Mittente (Sender)
    sAddress = xMailItem.SenderEmailAddress
    sName = xMailItem.SenderName
    If Not xDictAddresses.Exists(sAddress) And sAddress <> "" Then
        ' Se l'indirizzo del Mittente NON è già nel Dizionario e non è vuoto...
        xDictAddresses.Add sAddress, sName
        ' ...allora aggiungilo (chiave: indirizzo, valore: nome).
    End If

    ' B. Aggiungi tutti i Destinatari (Recipients)
    Set xRecipients = xMailItem.Recipients
    For Each xRecipient In xRecipients
        ' Scorre tutti i destinatari (A:, Cc:, Ccn:)
        xRecipient.Resolve ' Assicura che l'indirizzo sia risolto (se non lo è già)
        sAddress = xRecipient.Address
        sName = xRecipient.Name
        If Not xDictAddresses.Exists(sAddress) And sAddress <> "" Then
            ' Se l'indirizzo del Destinatario NON è già nel Dizionario e non è vuoto...
            xDictAddresses.Add sAddress, sName
            ' ...allora aggiungilo.
        End If
    Next xRecipient

    ' --- 2. ACCESSO ALLA RUBRICA ---

    Set xNameSpace = Outlook.Application.GetNamespace("MAPI")
    ' Si connette al sistema di archiviazione di Outlook (MAPI).
    Set xContactItems = xNameSpace.GetDefaultFolder(olFolderContacts).Items
    ' Ottiene la collezione di tutti gli elementi (Contatti) nella cartella "Contatti" predefinita.

    ' --- 3. CONTROLLO ESISTENZA E CREAZIONE CONTATTI ---

    For Each xAddress In xDictAddresses.Keys
        ' Scorre tutti gli indirizzi UNICI raccolti (Mittente + Destinatari).
        sAddress = CStr(xAddress)
        sName = CStr(xDictAddresses.Item(xAddress))
        
        Set xContact = Nothing
        ' Resetta la variabile per la ricerca del contatto prima di ogni tentativo.
        
        ' Cerca se l'indirizzo esiste nei campi EmailAddress (Outlook ne gestisce fino a 3: Email1, Email2, Email3)
        For lIdx = 1 To 3
            ' Il ciclo controlla i 3 possibili campi email del contatto.
            
            sFilterAddress = "[Email" & lIdx & "Address] = '" & Replace(sAddress, "'", "''") & "'"
            ' Costruisce la stringa di ricerca. Ad esempio: "[Email1Address] = 'pippo@example.com'".
            ' Il 'Replace' serve a gestire indirizzi che contengono apici (molto raro, ma sicuro).
            
            Set xContact = xContactItems.Find(sFilterAddress)
            ' Esegue la ricerca vera e propria nella rubrica.
            
            If Not (xContact Is Nothing) Then
                Exit For
                ' Se ha trovato il contatto (non è 'Nothing'), esce dal ciclo 1-3.
            End If
        Next lIdx
        
        ' Se il contatto NON è stato trovato dopo tutti i controlli (xContact è ancora Nothing)...
        If xContact Is Nothing Then
            Set xNewContact = Outlook.Application.CreateItem(olContactItem)
            ' Crea un NUOVO oggetto Contatto.
            With xNewContact
                ' Imposta le proprietà del nuovo contatto.
                .FullName = sName           ' Imposta il nome completo.
                .Email1Address = sAddress   ' Imposta l'indirizzo email principale.
                .Categories = "From Email"  ' Aggiunge la categoria 'From Email' per identificarlo facilmente.
                .Save                       ' Salva il nuovo contatto nella rubrica.
            End With
        End If
    Next xAddress
    
    ' --- 4. PULIZIA FINALE ---
    
    Set xDictAddresses = Nothing
    Set xRecipients = Nothing
    Set xContactItems = Nothing
    Set xNameSpace = Nothing
    ' Rilascia tutti gli oggetti utilizzati per liberare la memoria.
    
End Sub

• Salvare e riavviare Outlook. Al riavvio, la macro sarà attiva e funzionante.

FIG 1 - Outlook, Microsoft Visual Basic

Da questo momento, ogni volta che si risponde a un’email, il sistema salverà automaticamente il mittente e tutti i destinatari come nuovi contatti all’interno della cartella predefinita associata all’account di posta.

Considerazioni di sicurezza e governance

È bene sottolineare che l’utilizzo di macro VBA in Outlook può essere soggetto a policy di sicurezza aziendali. In molte organizzazioni, infatti, l’esecuzione di codice personalizzato è limitata per ridurre i rischi di attacchi tramite macro. Prima di implementare questa soluzione in un contesto enterprise, è quindi opportuno:

• Verificare le impostazioni di sicurezza di Outlook e le eventuali restrizioni IT.
• Valutare l’impatto sulla gestione centralizzata dei contatti, soprattutto se si utilizzano sistemi integrati come Microsoft Exchange o Microsoft 365.