1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44
|
Sub TestPublipost()
' Déclaration des variables
Dim iR As Integer
Dim i As Integer
Dim oDoc As Document
Dim DocName As String
Dim oDS As MailMergeDataSource
' Affectation des objets
Set oDoc = ActiveDocument
Set oDS = oDoc.MailMerge.DataSource
iR = oDoc.MailMerge.DataSource.RecordCount
Debug.Print iR
For i = 1 To iR
With oDoc.MailMerge
'Définition du premier et dernier enregistrement
.DataSource.FirstRecord = i
.DataSource.LastRecord = i
' Envoi des données dans un nouveau document
.Destination = wdSendToNewDocument
' Exécution du publipostage
.Execute
' Actualisation de l'enregistrement pour la sauvegarde
.DataSource.ActiveRecord = i
'Utilisation de deux champs pour obtenir le nom du document
DocName = .DataSource.DataFields(2).Value
'DocName = DocName & "Nom" & .DataSource.DataFields(3).Value
Debug.Print DocName; i
'Application.DisplayAlerts = False
With ActiveDocument
.SaveAs FileName:="D:\emailing\" & Format(Date, "yy") & Format(Date, "mm") & Format(Date, "dd") & Format(Time, "hhmm") & ".doc"
.Close
End With
End With
' Sauvegarde du document publiposté
With ActiveDocument
.ExportAsFixedFormat OutputFileName:="D:\emailing\testpdf" & DocName & ".pdf", ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True, 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
End With
Next i
End Sub |
Partager