Insomma, dopo tante richieste ho deciso di uscire dal torpore e inventarmi un piccolo escamotage per risolvere il problema dell’incorporamento di informazioni estratti dall’origine dati inserendole in un HTML.
Chi non conosce lo HTML non deve spaventarsi. Ho cercato di rendere davvero semplice l’introduzione a questa tecnologia riducendo davvero all’essenziale le spiegazioni.
I due file necessari sono reperibili nella sezione LAB-Download al punto 12TER.
Per chi capitasse qui per caso, sottolineo che questo tutorial è l’ultimo di una serie di tre dedicati sostanzialmente alla stampa unione. Facendo uso di VBA ho spiegato come, invece di stampare i contenuti, poterli inviare via email facendo uso di MS-Outlook allegando anche un PDF, molto utile nel caso, ad esempio, di invio massivo di attestati, manuali ecc. Con questo tutorial, come avete letto, cerco di rendere più gradevole il testo del messaggio email facendo uso di HTML. In questo modo, nel testo del messaggio, sarà possibile inserire tutta la formattazione necessaria ai testi, immagini, link.
Vi riporto il codice HTML utilizzato nell’esempio:
<!DOCTYPE html>
<html>
<body>
<h2>Buongiorno </h2>
<p>Ti stiamo inviando copia dell'attestato per l'aver frequentato e superato con successo il corso</p>
<p><strong>ilcorso </strong></p>
<p>Ti salutiamo cordialmente</p>
<p>La commissione</p>
<h2><img src="https://pngimage.net/wp-content/uploads/2018/06/flower-logo-png-2.png" alt="a free logo" width="200" /></h2>
</body>
</html>Ecco il video. Buon lavoro!
[mx_youtuber type="video" id="c3tAT7ZTssQ"]
Qui invece l’intero codice della macro (VBA):
Sub Unione_in_pdf()
Dim strFilename As String
Dim MyHTMLMessage As String, MyHTMLBody As String, MessaggioHTMLFinale As String, Utente As String
Dim iFile As Integer: iFile = FreeFile
'DIAMO PER SCONTATO CHE:
'1) IL FILE CHE CONTIENE LO html STATICO SIA SUL DESKTOP
'2) CHE IL FILE SIA DENOMINATO "myhtmlmessage.txt"
Utente = (Environ("USERPROFILE")) & "\DESKTOP\"
strFilename = Utente & "myhtmlmessage.txt"
'creo un oggetto outlook
Dim obj As New Outlook.Application
'oggetto che rappresenta l'email
Dim item As Outlook.MailItem
'instanzio l'oggetto
Set item = obj.CreateItem(Outlook.OlItemType.olMailItem)
'Crea un oggetto FileDialog per scegliere la cartella in cui salvare i file
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
'carica il messaggio HTML che contiene la parte finale HTML
Open strFilename For Input As #iFile
MyHTMLMessage = Input(LOF(iFile), iFile)
Close #iFile
'inizia procedura
With fd
'Usa il metodo Show per mostrare la finestra di dialogo e restituire l'azione dell'utente
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
'vrtSelectedItem è una stringa che contiene l'indirizzo di ogni elemento selezionato.
'E' possibile usare qualsiasi funzione di I/O sui file utilizzando questo indirizzo.
selectedpath = vrtSelectedItem
Next vrtSelectedItem
Else
MsgBox ("Nessuna cartella è stata selezionata.")
Exit Sub
End If
End With
'Imposta la variabile oggetto a Nothing
Set fd = Nothing
Application.ScreenUpdating = False
MainDoc = ActiveDocument.Name
ChangeFileOpenDirectory selectedpath
For i = 1 To ActiveDocument.MailMerge.DataSource.RecordCount
'instanzio l'oggetto item per l'email
Set item = obj.CreateItem(Outlook.OlItemType.olMailItem)
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = i
.LastRecord = i
.ActiveRecord = i
'Utilizza alcuni campi del file sorgente per impostare il nome del file pdf
'IMPORTANTE: tali campi vanno personalizzati in base a quelli effettivamente
'presenti nella sorgente dati
'-----attenti alle righe seguenti: nel database DEVE essere presente il campo denominato "nome e cognome"----
'-----ed inoltre un campo denominato "email"-------
docname = "Lettera_" & .DataFields("nome_e_cognome").Value & ".pdf"
'parte fissa dello HTML minimale
'ricordiamoci che ogni singola riga dovrà andare a capo con chr$(15)
MyHTMLBody = "<!DOCTYPE html>" & Chr$(15)
MyHTMLBody = MyHTMLBody & "<html>" & Chr$(15)
MyHTMLBody = MyHTMLBody & "<body>" & Chr$(15)
'aggiungiamo nome e cognome al body
MyHTMLBody = MyHTMLBody & "<h2>Buongiorno " & .DataFields("nome_e_cognome").Value & "</h2>" & Chr$(15)
MyHTMLBody = MyHTMLBody & "<p>Ti stiamo inviando copia dell" & Chr$(39) & "attestato per avere frequentato e superato con successo il corso</p>" & Chr$(15)
'ricorda che il simbolo doppi apici è chr$(34)
MyHTMLBody = MyHTMLBody & "<p><strong>" & Chr$(34) & .DataFields("Motivazione").Value & Chr$(34) & "</strong></p>" & Chr$(15)
EmailAddress = .DataFields("email").Value
' prendiamo il percorso completo del file da allegare
pdfallegato = selectedpath & "\" & docname
'----attenti a questa riga: personalizzate a piacimento il messaggio, inteso come corpo del testo-------
'messaggio = "Gentilissimo " & .DataFields("nome_e_cognome").Value & " Le inviamo in allegato la certificazione di partecipazione al convegno."
'----attenti a questa riga: qui mettete l'oggetto del vostro messaggio email-----
SoggettoEmail = "Invio certificato di partecipazione al Corso"
End With
.Execute Pause:=False
Application.ScreenUpdating = False
End With
ActiveDocument.ExportAsFixedFormat OutputFileName:=docname, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
ActiveWindow.Close SaveChanges:=False
'invia tramite outlook
item.Display
'imposto il destinatario
item.To = EmailAddress
'imposto l'indirizzo Carbon Copy
'item.CC = ""
'imposto il corpo del messaggio
'item.Body = messaggio
'componiamo tutto lo HTML
MessaggioHTMLFinale = MyHTMLBody & MyHTMLMessage
item.HTMLBody = MessaggioHTMLFinale
'imposto l'oggetto del messaggio
item.Subject = SoggettoEmail
'allegato
Set allegato = item.Attachments
allegato.Add pdfallegato
'invio l'email
item.Send
Set item = Nothing
Next i
MessaggioHTMLFinale = ""
Application.ScreenUpdating = True
End Sub