Outlook VBA salvare gli allegati delle email

Si riporta l'articolo scritto per il sito http://www.iprogrammatori.it/articoli/programmazione/art_vba-outlook-salvare-gli-allegati-delle-e_1385.aspx


Può capitare di creare una procedura in VBA, che permette di leggere tutte le email di una determinata cartella creata in Outlook (qualsiasi versione) e salvare sul computer gli allegati.
Le potenzialità offerte dal linguaggio Visual Basic Application, (VBA) permettono agli applicativi Office, di aggiungere funzionalità personalizzate da parte degli utenti migliorando così l’utilizzo del programma.

Stesura di codice


Dopo aver aperto Outulook (ogni versione è indifferente, l’unica differenza sta nel fatto di aprire la finestra dell’Editor VBA), dobbiamo aprire il programma per la stesura del codice VBA, in particolare l’ambiente VBA.
Una volta impostata la visualizzazione codice, scriviamo in alto la seguente dichiarazione che obbliga di scrivere la dichiarazione di variabile.


Option Explicit

Terminata di scrivere tale riga di codice, si riporta qui di seguita una funzione che permette di rilevare un oggetto di tipo “Folder” che permette di gestire il contenuto (email) . Con questo oggetto possiamo effettuare il ciclo su tutti gli elementi. Tramite l’oggetto Folders, possiamo passare il nome della cartella su cui vogliamo ricercare gli allegati nelle email.
Qui di seguito si riporta la funzione

Function GetFolderPath(ByVal NomeCartella As String) As Outlook.Folder
    Dim oFolder As Outlook.Folder
    On Error Errore
    Set oFolder = Application.Session.Folders.Item(1).Folders.Item(NomeCartella)
    Set GetFolderPath = oFolder
    Exit Function
Errore:
    Set GetFolderPath = Nothing
    Exit Function
End Function

A questo punto dobbiamo scrivere la macro che verrà eseguita dall’utente oppure tramite un pulsante posto sulla barra degli strumenti.
La funzione non fa altro che visualizzare a video, due richieste, quali nome cartella da esaminare ed il tipo di allegato (doc, zip, etc) che si vuole estrapolare.
Una volta ottenuta la folder, ciclo per ogni email trovata ed in essa per tutti gli allegati trovati.
Qui di seguito si riporta tale codice.

Dim objInbox As MAPIFolder
Dim objMail As Outlook.MailItem
Dim objAttachment As Outlook.Attachment
Dim strFileName As String
Dim strTargetPath As String
Dim ObjCartella As Folder
On Error GoTo Errore
Dim StrCartella As String
StrCartella = InputBox("Scrivere la cartella dalla quale estrapolare gli allegati dalle email.")
If Trim(StrCartella) = "" Then
 MsgBox "Indicare una cartella nella quale trovare gli allegati. ", vbInformation + vbOKOnly,
"Allegati"
    Exit Sub
End If
Dim StrTipoAllegato As String
StrTipoAllegato = InputBox("Indicare il tipo di file (Esempio per i word doc per i file di testo txt.", "SalvaAllegati", "doc")
If Trim(StrTipoAllegato) = "" Then
 MsgBox "Impossibile continuare, indicare il tipo di file. ", vbInformation + vbOKOnly, "Salva Allegati"
    Exit Sub
End If
Set ObjCartella = GetFolderPath(StrCartella)
If ObjCartella.Items.Count = 0 Then
 MsgBox "Non ci sono email nella cartella indicata. ", vbInformation + vbOKOnly, "Allegati"
    Exit Sub
End If
Dim NomeFileDaSalvare As String
Dim Elementi As Object
Dim AllegatoTrovato As Attachment
Dim IConta As Integer
Iconta = 1
For Each Elementi In ObjCartella.Items
    For Each AllegatoTrovato In Elementi.Attachments
    If Right(AllegatoTrovato.FileName, 3) = StrTipoAllegato Then
         NomeFileDaSalvare = "E:\" & Iconta &  AllegatoTrovato.FileName
         AllegatoTrovato.SaveAsFile NomeFileDaSalvare
         Iconta = Iconta + 1
      End If
    Next AllegatoTrovato
Next Elementi
Set objItems = Nothing
Set objInbox = Nothing
Set objMail = Nothing
Set objAttachment = Nothing
Exit Sub
Errore:
MsgBox ("Si è verificato il seguente errore: " & Err.Description)
End Sub

Conclusioni

Questo semplice script, fornisce al lettore una base di come lavorare sui singoli elementi contenuti in una cartella creata in outlook. Volendo si può estendere, apportando anche un ciclo su tutte le cartelle presenti.