Pagine

▼

Scripting - Stampare in automatico una mail con allegato in Outlook 2000/2003/2007/2010

Siccome sono nella necessità di stampare in automatico una mail con allegato che viene ricevuta in Outlook 2000/2003/2007/2010 ho visto che in giro ci sono diversi software che fanno tutto ciò. Il problema è che chiedono diverse decine di euro. 


Per questo motivo ho preparato un vba da implementare direttamente in outlook.


A grandi linee questo permette di memorizzare l'allegato in una cartella locale (c:\temp) ma è facile salvarla in un repository di rete con una piccola modifica.


Lo script gira di continuo controllando una particolare cartella se arriva mail (per questo si può implementare una regola per stampare solo alcune mail)


Volendo si potrebbe mandare una mail ad una lista di distribuzione per informarla del path di rete dove trovare il file (potrebbe essere utilizzato nel caso di un fax server centralizzato)


Tale tipo di script era nato per stampare i file excel ma io l'ho modificato per esigenze di stampa di un .pdf:



Nel caso in cui si fosse interessati a settare le mail stampate come lette è sufficiente implementare il seguente codice:



Sub Test1()
Application.ScreenUpdating = False

Dim objInbox As Outlook.MAPIFolder
Dim objOutlook As Object, objnSpace As Object, objMessage As Object

Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")
Set objInbox = objnSpace.GetDefaultFolder(olFolderInbox)

For Each objMessage In objInbox.Items
objMessage.UnRead = False
Next

Set objOutlook = Nothing
Set objnSpace = Nothing
Set objInbox = Nothing

Application.ScreenUpdating = True
End Sub


Per fare il debug può essere utile utilizzare l'opzione visualizza --> finestra variabili locali

Se non si trova il nome corretto della cartella possiamo usare il seguente codice, mettere un breakpoint e guardare in finestra variabili locali il nome corretto:


Private Sub Application_Startup()
     'some startup code to set our "event-sensitive" items collection
    Dim ns As Outlook.NameSpace
     '
    Set ns = Application.GetNamespace("MAPI")
    ns.Folders.Item (1)
    Set TargetFolderItems = ns.Folders.Item( _
    "Cassetta postale - MAZZANTI Alessandro - Sysdat").Folders.Item("Temp").Items
     
End Sub

Alternativamente utilizzare il codice 

Set TargetFolderItems = ns.Folders.Item(2).Folders.Item(1).Items

Dove in numeri vanno scelti opportunatamente
  1. Da Outlook, aprire VBEditor (Alt+F11)
  2. Aggiungere i riferimenti a "Microsoft Excel Object Library fron Strumenti --> Riferimenti 
  3. Copiare il codice sotto nel modulo ThisOutlookSession
  4. Creare una cartella in Outlook in "Temp" nella cartella di Exchange o nell'archivio locale della posta
  5. Creare la cartella "C:\Temp"
  6. Salvare il progetto
  7. Riavviare Outlook

<-------------------->

Ecco il codice vba



 '################################################################
 '### Module level Declarations
 'expose the items in the target folder to events
Option Explicit
Dim WithEvents TargetFolderItems As Items
 'set the string constant for the path to save attachments
Const FILE_PATH As String = "C:\Temp\"
 '###############################################################################
 '### this is the Application_Startup event code in the ThisOutlookSession module
Private Sub Application_Startup()
     'some startup code to set our "event-sensitive" items collection
    Dim ns As Outlook.NameSpace
     '
    Set ns = Application.GetNamespace("MAPI")
' modificare Cassetta postale - MAZZANTI Alessandro nel nome della cassetta personale
    Set TargetFolderItems = ns.Folders.Item( _
    "Cassetta postale - MAZZANTI Alessandro").Folders.Item("Temp").Items
     
End Sub
 '###############################################################################
 '### this is the ItemAdd event code
Sub TargetFolderItems_ItemAdd(ByVal Item As Object)
     'when a new item is added to our "watched folder" we can process it
    Dim olAtt As Attachment
    Dim i As Integer
     
    If Item.Attachments.Count > 0 Then
        For i = 1 To Item.Attachments.Count
            Set olAtt = Item.Attachments(i)
             'save the attachment
            olAtt.SaveAsFile FILE_PATH & olAtt.FileName
             
             'if its an Excel file, pass the filepath to the print routine
            If UCase(Right(olAtt.FileName, 3)) = "PDF" Then
                PrintAtt (FILE_PATH & olAtt.FileName)
            End If
        Next
    End If
     
    Set olAtt = Nothing
     
End Sub
 '###############################################################################
 '### this is the Application_Quit event code in the ThisOutlookSession module
Private Sub Application_Quit()
     
    Dim ns As Outlook.NameSpace
    Set TargetFolderItems = Nothing
    Set ns = Nothing
     
End Sub
 '###############################################################################
 '### print routine
Sub PrintAtt(fFullPath As String)
     
' per stampare file excel sremmare le seguenti righe e remmare quella finale
'    Dim xlApp As Excel.Application
'    Dim wb As Excel.Workbook
'
'     'in the background, create an instance of xl then open, print, quit
'    Set xlApp = New Excel.Application
'    Set wb = xlApp.Workbooks.Open(fFullPath)
'    wb.PrintOut
'    xlApp.Quit
'
'     'tidy up
'    Set wb = Nothing
'    Set xlApp = Nothing
' mettere il path di Adobe reader AcroRd32.exe
     Shell "C:\Program Files\Adobe\Reader 9.0\Reader\AcroRd32.exe /p /h " & fFullPath, vbHide
     
End Sub