Questo breve snippet ci consente di inviare un foglio di lavoro che abbiamo già preparato per una stampa PDF via email ad uno (o più) destinatari.
Potrete associare all’esecuzione del codice un pulsante o una combinazione da tastiera.
All’interno del codice sostituite gli indirizzi email, il nome del file, l’oggetto ed il corpo del messaggio.
La cella Z1, presente sul medesimo foglio e ovviamente da sostituire a proprio piacimento, contiene un valore variabile, come ad esempio la data di aggiornamento del documento.
Sub SendPDF()'
' SendPDF Macro
' Thanks to Vladimir Zakharov
' Adattamento: Maurizio Capannoli (www.acookabroad.it)
Dim IsCreated As Boolean
Dim i As Long
Dim DataAvanzamento As Variant
Dim PdfFile As String, Title As String
Dim OutlApp As Object ' Imposta il nome del file PDF ed estrai la data dalla cella Z1
Title = "Questo sarà il nome del file "
Range("Z1").Select DataAvanzamento = ActiveCell.Value ' Definisci il nome del file temporaneo PDF (allegato)
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & ActiveSheet.Name & ".pdf" ' Esporta il foglio corrente come PDF
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
' Se Outlook è già aperto, prova ad utilizzarlo
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
' Prepara la e-mail con allegato PDF
With OutlApp.CreateItem(0)
' Prepara la e-mail
.Subject = "Questo è l'oggetto della email " & DataAvanzamento & "."
.To = "This email address is being protected from spambots. You need JavaScript enabled to view it." ' <-- Metti qui la email del destinatario
.CC = "This email address is being protected from spambots. You need JavaScript enabled to view it." ' <-- metti qui la tua email se desideri una copia della email oppure commenta la riga
.Body = "Buongiorno," & vbLf & vbLf _
& "questo è il contenuto da mostrare aggiornato alla data " & DataAvanzamento & "." & vbLf & vbLf _
& "ATTENZIONE! IL FILE IN ALLEGATO CONTIENE DATI DI CUI NON ASSICURO LA VALIDITA'." & vbLf & vbLf _
& "QUI ALTRO TESTO OPPURE COMMENTA LA LINEA." & vbLf & vbLf _
& "Grazie. Distinti saluti. Baci & abbracci." & vbLf _
& Application.UserName & vbLf & vbLf
.Attachments.Add PdfFile
' Proviamo a spedire via Outlook
On Error Resume Next
.Send
Application.Visible = True
If Err Then
MsgBox "E-mail NON inviata", vbExclamation
Else
MsgBox "E-mail Inviata con successo!", vbInformation
End If
On Error GoTo 0
End With
' Cancella il file PDF temporaneo creato da questo codice
Kill PdfFile
' Chiudi istanza Outlook creata da questo codice
If IsCreated Then OutlApp.Quit
' Pulisci la memoria
Set OutlApp = Nothing
End Sub