Serienbrief als PDF spiechern
17.12.2018 13:07:30
Schmalfuß
ich möchte aus einer Excelliste einen Serienbrief erstellen. Das ist ja nun kein Problem.
Dieser Serienbrief soll als Einzel- PDF abgespeichert werden. Dazu habe ich auch ein VBA-Code gefunden. Der funktioniert eigentlich schon.
Jetzt das große ABER.
In diesem Code steht als Dateibezeichung die BestellerNr.
Ich benötige aber auch noch die Produktgruppe dazu, da ein Besteller mehrere Produkte bestellen kann.
Wie kann ich nun den Code verändern, dass z.B. BestellerNr._Produktgruppe als PDF erstellt wird. Kann mir da jemand helfen?
Anbei mein VBA-Code:
Sub Serienbrief_im_PDF_Format_speichern()
' set variables
Dim iBrief As Integer, sBrief As String
Dim AppShell As Object
Dim BrowseDir As Variant
Dim Path As String
' catch any errors
On Error GoTo ErrorHandling
' determine path
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
Path = Path & "\Serienbrief-" & Format(Now, "dd.mm.yyyy-hh.mm.ss") & "\"
MkDir Path
On Error GoTo ErrorHandling
' hide application for better performance
MsgBox "Serienbriefe werden exportiert. Dieser Vorganag kann einige Minuten dauern - _
Microsoft Word wird während dieser Zeit ausgeblendet", vbOKOnly + vbInformation
Application.Visible = False
' create bulkletter and export as pdf
With ActiveDocument.MailMerge
.DataSource.ActiveRecord = 1
Do
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = .ActiveRecord
.LastRecord = .ActiveRecord
sBrief = Path & .DataFields("BestellerNr").Value & ".pdf"
End With
.Execute Pause:=False
If .DataSource.DataFields("BestellerNr").Value > "" Then
ActiveDocument.SaveAs FileName:=sBrief, FileFormat:=wdFormatPDF
End If
ActiveDocument.Close False
If .DataSource.ActiveRecord 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