Risolto Stampa unione con creazione file PDF ed invio mail con allegato personalizzato

MarioGhi

Nuovo utente
9 Settembre 2016
8
1
Brescia
2007
1
Buongiorno,
vi scrivo per un problema che non riesco a risolvere su una stampa unione. Premetto che conosco poco il vb, uso la versione office 2013.
Devo inviare via mail un documento personalizzato ad un migliaio di fornitori, ho creato in word con la procedura di stampa unione il documento “informativa clienti fornitori.docx” che ha un campo (Deco_Fornitore) collegato al foglio “elenco.xlsx”. Con gli strumenti standard della stampa unione non posso personalizzare tutto, la macro dovrà creare un PDF (nominato con COD_FORNITORE.PDF), memorizzarlo nella cartella C:\stampe , poi deve usare il campo “Mail” per inviare con Outlook una mail con qualche testo e con il documento PDF allegato appena creato. Questo va ripetuto per ogni riga del file Elenco.xlsx.
Alla fine mi troverò nella cartella C:\Stampe tutti i file PDF creati, nominati con il codice fornitore, ed in posta inviata di Outlook avrò tutte le mail singole inviate ai miei fornitori, ognuna con il loro PDF allegato, fine del lavoro.
Ho cercato in rete ed ho trovato diversi spunti, numerosi sul vostro sito, che mi hanno permesso di adattare la macro nel file di word, ma il problema è che viene creato sempre il PDF corrispondente alla prima riga di dati, invia correttamente la mail, ma non passa alla riga successiva.
Codice inserito sul file di word:

Visual Basic:
Sub Unione_in_pdf()
'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)
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.
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
ChangeFileOpenDirectory "c:\stampe"

'For i = 1 To ActiveDocument.MailMerge.DataSource.RecordCount
For I = 1 To 4

'istanzio 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
    docname = .DataFields("COD_FORNITORE").Value & ".pdf"
    EmailAddress = .DataFields("EMAIL").Value

' prendiamo il percorso completo del file da allegare
    pdfallegato = selectedpath & "\" & docname

'—-corpo del testo——-
    messaggio = "Spett. " & .DataFields("DECO_FORNITORE").Value & vbCrLf & "Inviamo in allegato l'informativa del consenso sul trattamento dei dati, da restituire firmata." & vbCrLf & vbCrLf & "Distinti Saluti" & vbCrLf & "PINCOPALLO"

'—-oggetto del messaggio email—–
    SoggettoEmail = "Invio informativa Privacy"
    End With
'.Execute Pause:=False           'dovuto commentare perché si blocca la routine

    End With

    ActiveDocument.ExportAsFixedFormat OutputFileName:=docname, _
    ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
    wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=I, To:=I, _
    item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
    CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
    BitmapMissingFonts:=True, UseISO19005_1:=False
    'ActiveWindow.Close SaveChanges:=False      'rimossa perchè altrimenti chiude il DOC originale

    'invia tramite outlook
    'imposto il destinatario
    item.To = EmailAddress
    'imposto il corpo del messaggio
    item.Body = messaggio
    '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
Application.ScreenUpdating = True
End Sub

ho dovuto rimuovere la stringa "ActiveWindow.Close SaveChanges:=False" perchè chiudeva il file di Word originale e anche la riga ".Execute Pause:=False" perchè si fermava
Allego i file usati, chiedo il vostro aiuto per capire dov’è l’errore, grazie.
 

Allegati

giulianovac

Access/VBA Expert
Staff
9 Giugno 2018
5.074
245
Italy
2019
402
Ti consiglio di guardare nei TUTORIAL, ho inserito diversi esempi, e probabilmente con qualche adattamento potrebbe esserti di aiuto.
 

MarioGhi

Nuovo utente
9 Settembre 2016
8
1
Brescia
2007
1
Buongiorno, ho risolto con questa:

Visual Basic:
Sub Un_pdf()
'Application.ScreenUpdating = false
'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)
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

'istanzio 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 = .DataFields("COD_FORNITORE").Value & ".pdf"
    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——-
'‘—-corpo del testo——-
    messaggio = "Spett. " & .DataFields("DECO_FORNITORE").Value & vbCrLf & vbCrLf & "Inviamo in allegato l'informativa del consenso sul trattamento dei dati, da restituire firmata." & vbCrLf & vbCrLf & "Distinti Saluti" & vbCrLf & "Ditta"

'‘—-oggetto del messaggio email—–
    SoggettoEmail = "Invio informativa Privacy"
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
'imposto il destinatario
item.To = EmailAddress
'imposto il corpo del messaggio
item.Body = messaggio
'imposto l’oggetto del messaggio
item.Subject = SoggettoEmail
'allegato
Set allegato = item.Attachments
allegato.Add pdfallegato
'invio l’email
item.Send
'item.Display
Set item = Nothing

Next i

Application.ScreenUpdating = True

End Sub
Contrassegnatelo come completato, grazie ciao
 

ildragoncello

Utente abituale
22 Dicembre 2020
186
30
Castelnuovo Magra - SP
2019 - Win10 Pr
12
Buongiorno a tutti.
Ho trovato molto utile questo script, ma ho riscontrato un problema al momento dell'invio delle mail Outlook mi segnala che il documento allegato è aperto o utilizzato da un altro utente. Rispondo Si e procede regolarmente sino alla fine, ma ovviamente vedere questo messaggio è molto fastidioso se le mail sono tante.
C'è una soluzione?

Grazie
 

alfrimpa

VBA Expert
Supermoderatore
18 Dicembre 2015
37.931
2.445
67
Napoli
Office 365
1.210
ildragoncello @ildragoncello

Non ci si accoda a vecchie discussioni; devi aprirne una nuova
 

Impe01

Nuovo utente
6 Giugno 2018
9
1
Monte Porzio Catone
windows xp
0
Buongiorno, ho provato anche io ad effettuare la prova di invio pdf mediante stampa unione da elenco. SOno riuscito però soltanto a creare dei pdf in una cartella, ma non ad effettuare l'invio mediante outlook. Il codice FUNZIONANTE che mi consente la creazione di pdf è il seguente:

Sub Unione_in_pdf()

'Crea un oggetto FileDialog per scegliere la cartella in cui salvare i file
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
'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

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("Cognome").Value & ".pdf"
' prendiamo il percorso completo del file da allegare
pdfallegato = selectedpath & "\" & docname

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

Next I

Application.ScreenUpdating = True
End Sub

NON MI FUNZIONA INVECE IL SEGUENTE CODICE (mi segnala errore di sintassi) CHE DOVREBBE COMPLETARE L'OPERAZIONE CON LA SPEDIZIONE VIA MAIL DA ELENCO. Credo ci sia problema con configuarzione outlook, ma se invio mediante stampa unione l'allegato word, funziona perfettamente. Questo è il codice non funzionante:

Sub xUnione_in_pdf()
‘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)
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

‘istanzio 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(“Cognome”).Value & “.pdf”
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(“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 convegno”
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
‘imposto il destinatario
item.To = EmailAddress
‘imposto il corpo del messaggio
item.Body = messaggio
‘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

Application.ScreenUpdating = True

End Sub

Qualcuno mi può dare suggerimenti?
grazie mille
 

alfrimpa

VBA Expert
Supermoderatore
18 Dicembre 2015
37.931
2.445
67
Napoli
Office 365
1.210
I @Impe01

Non devi accodarti a vecchie discussioni; se hai un problema devi aprirne una nuova.

Il codice nei post va inserito tra i TAG CODE; per come fare consulta gli avvisi dello staff.
 

Sostieni ForumExcel

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