Macro per Outlook 2003 - Inoltra come allegato
Sembra incredibile, ma in Outlook 2003 manca la funzione "Invia come allegato", che è presente in qualsiasi client di posta prodotto da quando è stata inventata la posta elettronica.
O meglio, esiste la possibilità tramite le opzioni di impostare questa funzione, ma sarà valida per tutte le mail inoltrate.
Questo a mio avviso è un grosso limite, che si è manifestato in tutto il suo splendore quando è stata implementata, nell'azienda dove lavoro, la funzione di archiviazione delle mail relative ad un ordine sotto SAP.
Girando un pò per i vari forum che trattano le macro di Outlook (da eggheadcafe.com a dotnethell.it) ho messo insieme questo codice che permette di creare una macro che inoltra come allegato la mail selezionata.
Funziona sia aprendo la mail nella sua finestra di lettura, che dalla schermata di riepilogo di outlook.
' Codice importato da eggheadcafe.com
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application
Set objApp = Application
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = _
objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = _
objApp.ActiveInspector.CurrentItem
Case Else
End Select
End Function
Sub InviaComeAllegato()
Set allegato = GetCurrentItem()
Dim appOL As New Outlook.Application
Dim CreaNuovaEmail As Outlook.MailItem
Set CreaNuovaEmail = appOL.CreateItem(olMailItem)
With CreaNuovaEmail
'Destinatario predefinito, commentare la riga sotto per lasciarlo libero
.To = "indirizzodiposta@elettronica.com"
'Oggetto predefinito impostato uguale all'oggetto dell'allegato
'Per impostare un oggetto differente, mettere .Subject = "Oggetto predefinito"
.Subject = allegato.Subject
'Prendo la mail selezionata e la allego
.Attachments.Add allegato
'Fa apparire la finestra
.Display
'Salva il messaggio
.Save
End With
'Reset dei valori
Set appOL = Nothing
Set CreaNuovaEmail = Nothing
End Sub
