AW: Massen PDF Erstellung per Makro
21.05.2017 10:44:42
Hajo_Zi
ich konnte in der Datei keine Mitarbeiter finden.
Mache es doch über Word Serienbrief?
Word Code
Option Explicit
' http://www.office- _
loesung.de/ftopic531017_0_0_asc.php#2632365
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
' Ordner geänder auf Jahr.Monat.Tag
Path = Path & "\Serienbrief-" & Format(Now, "yyyy.mm.dd-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 & "2017-01-17 LTR Kollektivbonus 2016 " & .DataFields("Name"). _
Value & .DataFields("Vorname").Value & ".pdf"
End With
.Execute Pause:=False
If .DataSource.DataFields("Name").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