Seriendruck nur eine Seite

Sub Serienbrief()
Application.ScreenUpdating = False
Dim myWord As Object
On Error Resume Next
Set myWord = GetObject("Word.Application.10")
If Err.Number <> 0 Then
Err.Clear
Set myWord = CreateObject("Word.Application.10")
myWord.Visible = True: objWW.WindowState = wdWindowStateMaximize
Else
myWord.Activate
myWord.Visible = True: objWW.WindowState = wdWindowStateMaximize
End If
Call Makro
'Serienbriefe drucken
With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.MailAsAttachment = False
.MailAddressFieldName = ""
.MailSubject = ""
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=True
End With
myWord.ActiveDocument.PrintOut
myWord.ActiveDocument.Close savechanges:=False
ThisDocument.Close (Word.WdSaveOptions.wdDoNotSaveChanges)
myWord.Application.Quit (True)
Set myWord = Nothing
End Sub

Sub Makro()
Application.ScreenUpdating = False
Dim wdAnw As Object
Dim wdDok As Object
Set wdDok = GetObject("C:\Dokumente ...... \SerienbriefFremd11.dot")
Set wdAnw = wdDok.Parent
wdAnw.Visible = True
wdAnw.WindowState = 1 '0 = Normal; 1 = Maximized; 2 = Minimized
wdAnw.Activate
'wdDok.Close
'wdAnw.Quit
Set wdDok = Nothing
Set wdAnw = Nothing
End Sub