Tutorial Inviare mail a più destinatari con allegato PDF personalizzato

Stato
Chiusa ad ulteriori risposte.

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
20.197
1.733
Como
2011MAC 2016WIN
413
Ciao a tutti,
vi propongo di seguito una soluzione per inviare e-mail a più destinatari allegando un PDF che viene personalizzato per ciascuno di loro.

Innanzitutto mi servono due variabili per gestire Outlook
Codice:
 Dim OutApp As Object
Dim OutMail As Object
Poichè uso due fogli (uno per il i dati e le mail e uno per creare poi il PDF) mi servono due variabili, una per ciascun foglio
Codice:
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Una variabile per trovare l'ultima riga piena del foglio con gli indirizzi
Codice:
Dim uR As Long
Un'altra per ciclare i dati
Codice:
Dim i As Long
Poi due variabili per l'indirizzo mail e il testo
Codice:
Dim strAdd As String
Dim strBody As String
Due variabili ancora per il percorso e il nome del file PDF
Codice:
Dim percorso As String
Dim nomefile As String
Infine visto che voglio che compaia un messaggio che mi avvisi che sto spedendo le mail, mi serve una variabile per l'inputbox
Dim domanda As String

Queste le dichiarazioni complete
Codice:
 Dim OutApp As Object
    Dim OutMail As Object
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim strAdd As String
    Dim strBody As String
    Dim uR As Long
    Dim i As Long
    Dim dati As Range
    Dim percorso As String
    Dim nomefile As String
    Dim domanda As String
A questo la prima cosa faccio comparire il messaggio con la domanda, se si scegli di si vengono spedite le mail, altrimenti si esce dalla macro
Codice:
 domanda = MsgBox("Stai per spedire la lettera a tutti gli indirizzi della colonna D del Foglio1!" & vbCrLf & "Vuoi proseguire?", vbYesNo + vbExclamation, "ATTENZIONE")
    If domanda = vbNo Then Exit Sub
    If domanda = vbYes Then
.....
Nel caso si scelga di procedere (si) si procede con l'impostazione dei fogli e di Outlook
Codice:
Set sh1 = Sheets("Foglio1")
Set sh2 = Sheets("Foglio2")
Set OutApp = CreateObject("Outlook.Application")
......
.....
Set OutMail = OutApp.CreateItem(0)
Trovando l'ultima riga del Foglio con gli indirizzi si passa al secondo foglio (aggiungo .Visible = true perchè lo voglio poi nascondere e tenere sempre nascosto)
Codice:
 uR = sh1.Cells(Rows.Count, 1).End(xlUp).Row
  With sh2
   .Visible = True
Spiego adesso il pezzo di codice che posto di seguito riferendomi alla riga con dei numeri
Avvio il ciclo For dalla riga 2 all'ultima piena (1)
Nella cella D8 scrivo nome e cognome (prendendolo dal Foglio1 col ciclo) (2)
Nella cella A14 scrivo un messaggio seguito da un numero preso dal Foglio1 (3)
Imposto come variabile Dati l'area che poi mi serve per salvarla nel PDF (Nel mio caso ho scelto A1:E20)(4)
definisco il percorso (Application.DefaultFilePath) nella stessa posizione dove sitrova il mio file Excel (5)
scelgo il nome del file (che lo chiamo con il cognome del Foglio1 che prendo col ciclo) (6)
A questo punto esporto l'area come PDF (7)
Con la variabile strAdd mi prendo la mail del e destinatario (8)
Con strBody il corpo del testo (9)
Codice:
For i = 2 To uR (1)
                .Range("D8") = sh1.Range("A" & i) & " " & sh1.Range("B" & i) (2)
                .Range("A14") = "Quello in nostro possesso è il seguente: " & sh1.Range("C" & i) (3)
                Set dati = .Range("A1:E20") (4)
                percorso = Application.DefaultFilePath (5)
                nomefile = sh1.Range("A" & i) & ".pdf" (6)
                dati.ExportAsFixedFormat Type:=xlTypePDF, Filename:=percorso & nomefile, _
                    Quality:=xlQualityStandard, OpenAfterPublish:=False (7)
                strAdd = sh1.Range("D" & i) (8)
                strBody = "Si trasmette il documento allegato." & vbCrLf & "Distinti saluti."(9)
A questo punto passiamo i dati a Outlook
Lascio .Send commentato, se si vogliono realmente inviare le mail senza visualizzare outlook basta commentare .Display e decommentare .Send
Codice:
With OutMail
                    .To = strAdd
                    .CC = ""
                    .Attachments.Add (percorso & nomefile)
                    .BCC = ""
                    .Subject = "Comunicazione"
                    .Body = strBody
                    .display
                    '.Send
                End With
Il file a questo punto è stato spedito, però abbiamo il PDF ancora presente che dobbiamo distruggere prima di creare l'altro
Codice:
 Kill percorso & nomefile
Alla fine rimetto il Foglio2 nascosto
Codice:
 Next i
.Visible = False
End With
Ripulisco i riferimenti dalle impostazioni e con un messaggio avviso del buon esito dell'invio delle mail
Codice:
    Set OutApp = Nothing
    Set sh1 = Nothing
    Set sh2 = Nothing
    MsgBox "Tulle le e-mail sono state inviate correttamente!", vbInformation, "AVVISO"
Il codice completo è questo:
Codice:
Sub Invia_mail_con_allegati_PDF()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim strAdd As String
    Dim strBody As String
    Dim uR As Long
    Dim i As Long
    Dim dati As Range
    Dim percorso As String
    Dim nomefile As String
    Dim domanda As String
    Application.ScreenUpdating = False
    domanda = MsgBox("Stai per spedire la lettera a tutti gli indirizzi della colonna D del Foglio1!" & vbCrLf & "Vuoi proseguire?", vbYesNo + vbExclamation, "ATTENZIONE")
    If domanda = vbNo Then Exit Sub
    If domanda = vbYes Then
    Set sh1 = Sheets("Foglio1")
    Set sh2 = Sheets("Foglio2")
    Set OutApp = CreateObject("Outlook.Application")
        uR = sh1.Cells(Rows.Count, 1).End(xlUp).Row
        With sh2
            .Visible = True
            For i = 2 To uR
                .Range("D8") = sh1.Range("A" & i) & " " & sh1.Range("B" & i)
                .Range("A14") = "Quello in nostro possesso è il seguente: " & sh1.Range("C" & i)
                .Range("A18") = "Como, " & Date
                Set dati = .Range("A1:E20")
                percorso = Application.DefaultFilePath
                nomefile = sh1.Range("A" & i) & ".pdf"
                dati.ExportAsFixedFormat Type:=xlTypePDF, Filename:=percorso & nomefile, _
                    Quality:=xlQualityStandard, OpenAfterPublish:=False
                Set OutMail = OutApp.CreateItem(0)
                strAdd = sh1.Range("D" & i)
                strBody = "Si trasmette il documento allegato." & vbCrLf & "Distinti saluti."
                With OutMail
                    .To = strAdd
                    .CC = ""
                    .Attachments.Add (percorso & nomefile)
                    .BCC = ""
                    .Subject = "Comunicazione"
                    .Body = strBody
                    .display
                    '.Send
                End With
                Set OutMail = Nothing
                Kill percorso & nomefile
            Next i
            .Visible = False
        End With
    End If
    Set OutApp = Nothing
    Set sh1 = Nothing
    Set sh2 = Nothing
    MsgBox "Tulle le e-mail sono state inviate correttamente!", vbInformation, "AVVISO"
    Application.ScreenUpdating = True
End Sub
 

Allegati

Stato
Chiusa ad ulteriori risposte.

Sostieni ForumExcel

Aiutaci a sostenere le spese e a mantenere online la community attraverso una libera donazione!