Serienbrief - Jeder Datenatz als PDF speichern

Sie möchten einen Serienbrief erstellen und dabei jeden einzelnen Datensatz als eigene PDF-Datei speichern.

Mit folgendem VBA-Code funktioniert dies!

Vorgehen

1. Word-Datei (Brief) normal mit der Datenquelle verbinden
2. Seriendruckfelder einfügen
3. Code (siehe unten) in neues Modul im Word-VBA-Editor kopieren

Wichtig / Zu beachten
Damit der Code funktioniert, müssen Sie
- die Regel für die Definition des Dateinamens festlegen (siehe "Dateinahmen definieren für PDF-Dateien").
- bei Bedarf können sie den Namen des Unterordners anpassen (siehe "Unterordner definieren")

VBA-Code

Sub Serienbrief()

'Definition der Variablen
Dim iBrief As Integer, sBrief As String
Dim AppShell As Object
Dim BrowseDir As Variant
Dim Path As String

'Errhorhandler
On Error GoTo ErrorHandling

'Auswahlfenster Pfad - Windows-Fenster zur Pfad-Auswahl wird während Programm-Ausführung eingeblendet
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Speicherort für Serienbriefe auswählen", 0, 16)

If BrowseDir = "Desktop" Then
Path = CreateObject("WScript.Shell").SpecialFolders("Desktop")
Else
Path = BrowseDir.items().Item().Path
End If

If Path = "" Then GoTo ErrorHandling


'Unterordner definieren, in welchen die PDF-Dateien gespeichert werden sollen
'=========================================================================
Path = Path & "\Serienbrief_" & Format(Now, "yyyymmdd_hhmm") & "\"
'Erstellt den Unterordner
MkDir Path

On Error GoTo ErrorHandling

'Applikation ausblenden - für bessere Performance
MsgBox "Serienbriefe werden exportiert. Dieser Vorgang kann einige Minuten dauern - Microsoft Word wird während dieser Zeit ausgeblendet", vbOKOnly + vbInformation
Application.Visible = False

'Erstelle Serienbrief und Export als PDF
With ActiveDocument.MailMerge
.DataSource.ActiveRecord = 1
Do
.Destination = wdSendToNewDocument
.SuppressBlankLines = True

With .DataSource
.FirstRecord = .ActiveRecord
.LastRecord = .ActiveRecord

'Dateinamen definieren für PDF-Dateien
'============================================================
sBrief = Path & .DataFields("BPNr").Value & "_" & .DataFields("Name").Value & ".pdf"

End With

.Execute Pause:=False

If .DataSource.DataFields("BPNr").Value > "" Then
ActiveDocument.SaveAs FileName:=sBrief, FileFormat:=wdFormatPDF
End If
ActiveDocument.Close False

If .DataSource.ActiveRecord < .DataSource.RecordCount Then
.DataSource.ActiveRecord = wdNextRecord
Else
Exit Do
End If

'Nächster Datensatz
Loop

End With


'Errorhandling
ErrorHandling:
Application.Visible = True

If Err.Number = 76 Then
MsgBox "Der ausgewählte Speicherort ist ungültig", vbOKOnly + vbCritical
ElseIf Err.Number = 5852 Then
MsgBox "Das Dokument ist kein Serienbrief"
ElseIf Err.Number = 4198 Then
MsgBox "Der ausgewählte Speicherort ist ungültig", vbOKOnly + vbCritical
ElseIf Err.Number = 91 Then
MsgBox "Exportieren von Serienbriefen abgebrochen", vbOKOnly + vbExclamation
ElseIf Err.Number > 0 Then
MsgBox "Unbekannter Fehler: " & Err.Number & " - Bitte Makro erneut ausführen.", vbOKOnly + vbCritical
Else
MsgBox "Serienbriefe erfolgreich exportiert", vbOKOnly + vbInformation
End If

End Sub