Word-Serienbrief in einzelne Word- oder PDF-Dateien speichern
vereinfachte und verbesserte Version:
formletter2pdf - die Weiterentwicklung des Makros als Open Source-Projekt, mit Einstellungsdialog und Schritt-für-Schritt Anleitung:
Das folgende Makro für Microsoft Word 2007 und Word 2010, dient dazu die einzelnen Schreiben der Serienbrieffunktion als getrennte Dateien zu speichern. Das Makro erfragt nach dem Start nach dem Speicherort. Dabei wird am Speicherort automatisch ein Ordner der die Serienbriefe enthält erstellt. Der Dateiname der einzelnen Dateien wird dabei aus einem der Datenfelder des Serienbriefs generiert. Um die Generierung der Serienbriefe zu beschleunigen, wird während des Vorgangs das Word-Fenster ausgeblendet.
Sub Serienbrief()
' 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("ID").Value & ".pdf"
End With
.Execute Pause:=False
If .DataSource.DataFields("ID").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
Loop
End With
' error handling
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
Im obigen Skript wird der Dateiname aus dem Feld ID des Serienbrief-Datensatzes generiert. Passen Sie in den Zeilen sBrief = Path & .DataFields("ID").Value & ".pdf" und If .DataSource.DataFields("ID").Value > "" Then den Namen des Datenbankfelds (hier ID) an, um ein beliebiges Datenbankfeld für die Generierung des Dateinamens zu nutzen.
Mittlerweile habe ich das Makro auf vielen unterschiedlichen Systemen benutzt und die Erfahrung gemacht, dass zumindest bei Office 2007 alle aktuellen Updates (Service Pack 3) eingespielt sein müssen, damit das Makro überhaupt läuft.
Aufgrund der zahlreichen Rückmeldungen hier im Blog habe ich das Makro optimiert und als Open Source-Projekt weiterentwickelt. Mehr dazu auf der Projekt-Website www.formletter2pdf.com.
Word-Dokumente anstelle von PDF-Dateien speichern
Das obige Skript nutzt die PDF-Funktion von Office um die Dateien als PDF zu sichern. Um die Dateien im Word Format zu sichern, passen Sie die folgende Zeile an um dem Dateinamen die Endung .doc zu verpassen:
sBrief = Path & .DataFields("ID").Value & ".pdf"
wird zu
sBrief = Path & .DataFields("ID").Value & ".doc"
Und ändern Sie die folgende Zeile, um das Ausgabeformat von PDF auf Word umzustellen:
ActiveDocument.SaveAs FileName:=sBrief, FileFormat:=wdFormatPDF
wird zu
ActiveDocument.SaveAs FileName:=sBrief
Variante für Office for Mac
Microsoft Office unter Windows und Office for Mac unterscheiden sich in diversen Funktionen und den Möglichkeiten in der Makroprogrammierung. Daher hier der adaptierte Code für Office for Mac (bisher nur unter Office for Mac 2011 getestet):
Sub Serienbrief()
' 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
Path = MacScript("(choose folder with prompt ""Speicherort für Serienbriefe auswählen"") as string")
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
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' create bulkletter and export as pdf
With ActiveDocument.MailMerge
.DataSource.ActiveRecord = 1
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
.DataSource.ActiveRecord = wdLastRecord
RecordCount = .DataSource.ActiveRecord
.DataSource.ActiveRecord = 1
Do
With .DataSource
.FirstRecord = .ActiveRecord
.lastRecord = .ActiveRecord
sBrief = Path & .DataFields("ID").Value & ".pdf"
End With
.Execute Pause:=False
If .DataSource.DataFields("ID").Value > "" Then
ActiveDocument.SaveAs fileName:=sBrief, FileFormat:=wdFormatPDF
End If
ActiveDocument.Close False
If .DataSource.ActiveRecord < RecordCount Then
.DataSource.ActiveRecord = .DataSource.ActiveRecord + 1
Else
Exit Do
End If
Loop
End With
' error handling
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
Vielen Dank, das Macro laeuft fast einwandfrei! Es gibt nur ein kleines Problem, es endet nicht!
Ich habe
sBrief = Path & .DataFields("ID").Value & ".pdf"
angepasst:
sBrief = Path & .DataFields("Customer").Value & .DataFields("Quote_Number").Value & ".pdf"
Das als letzter Brief von Word angezeigte Dokument hat noch einen Customer Namen. Trotzdem scheint das Macro ein Dokument speichern zu wollen, dass weder Customer noch Quote_Number besitzt, und somit keinen gueltigen Speichernamen besitzt.
Die Daten fuer den Serienbrief beziehe ich aus einer Exceltabelle, von der 115 Zeilen befuellt sind, danach sind nur noch Leerzeilen, von denen allerdings einige Felder Formeln enthalten. Diese kann ich aber auch nicht loeschen, da monatlich neue Eintraege hinzukommen koennen. Und eigentlich duerfte das kein Problem sein, da Word in der Serienbrieffunktion ja sowieso nur die Values uebernimmt, und nicht die Formeln, oder?
Kann ich den Code erweitern, sodass das Macro automatisch stoppt, wenn das Feld "Customer" nicht befuellt ist?
Danke fuer die Hilfe schonmal!