Sub EinzelnerDatensatz()
Dim Pfad As String
Dim Seriendruckfeld As String
Seriendruckfeld = "Nummer"
Pfad = "C:\Daten\E-Mail-Serienbrief"
With ActiveDocument.MailMerge
If .MainDocumentType = wdNotAMergeDocument Then
MsgBox "Das aktive Dokument ist kein Seriendruckhauptdokument."
Exit Sub
End If
.DataSource.ActiveRecord = wdLastRecord
anzahl = .DataSource.ActiveRecord
If anzahl = 0 Then
MsgBox "Die Datenquelle ist leer."
Exit Sub
End If
.Destination = wdSendToNewDocument
For i = 1 To anzahl
.DataSource.ActiveRecord = i
dsname = Pfad & _
.DataSource.DataFields(Seriendruckfeld).Value & ".pdf"
.DataSource.FirstRecord = i
.DataSource.LastRecord = i
.Execute
ActiveDocument.Range.Find.Execute FindText:="^b", replacewith:=""
SaveAsPDF (dsname)
ActiveDocument.Close (wdDoNotSaveChanges)
Next i
.DataSource.FirstRecord = 1
End With
End Sub
Sub SaveAsPDFandMail(FilePath As String)
Dim outl As Object
Dim Mail As Object
Dim strDatei As String
strDatei = "C:\Daten\E-Mail-Serienbrief\Preise2017.pdf"
ActiveDocument.ExportAsFixedFormat OutputFileName:=strDatei, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
Set outl = CreateObject("Outlook.Application")
Set Mail = outl.CreateItem(0)
Mail.Subject = "Preise 2017 - Firma XYZ"
Mail.Body = "Sehr geehrte Damen und Herren,......"
Mail.To = "mail@provider.de"
Mail.Attachments.Add strDatei
Mail.Display
End Sub