Cassius1985
Captain
- Registriert
- Sep. 2004
- Beiträge
- 3.600
Moin Moin,
ich habe aus dem Netz ein Makro als Basis für einen Word-Serienbrief zu PDF-Makro benutzt.
Es funktioniert auch 1a, bis auf den Punkt dass im PDF immer eine 2., leer Seite erstellt wird.
Ich kann den Fehler umgehen, indem ich in dem Word-Dokument bis zur Fußzeile 2 Zeilen platz lasse, ich möchte allerdings ganz unten am Dokument einen Text und das Tagesdatum stehen haben und nicht 3cm überhalb der Fußzeile :/
In der Einzelausführung (F8) habe ich gesehen dass er rechts unten wo das Datum steht noch :::::::::::: dahinter setzt.
Im Original Dokument, dass ich leider nicht zur Verfügung stellen kann, sind diese Punkte aber nicht vorhanden.
Hier der Code:
ich habe aus dem Netz ein Makro als Basis für einen Word-Serienbrief zu PDF-Makro benutzt.
Es funktioniert auch 1a, bis auf den Punkt dass im PDF immer eine 2., leer Seite erstellt wird.
Ich kann den Fehler umgehen, indem ich in dem Word-Dokument bis zur Fußzeile 2 Zeilen platz lasse, ich möchte allerdings ganz unten am Dokument einen Text und das Tagesdatum stehen haben und nicht 3cm überhalb der Fußzeile :/
In der Einzelausführung (F8) habe ich gesehen dass er rechts unten wo das Datum steht noch :::::::::::: dahinter setzt.
Im Original Dokument, dass ich leider nicht zur Verfügung stellen kann, sind diese Punkte aber nicht vorhanden.
Hier der Code:
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 & "\Ausgegeben am " & Format(Now, "dd.mm.yyyy") & "\"
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("Ableser_N").Value & " " & Format(Now, "dd.mm.yyyy") & " " & "Auftrag " & .DataFields("Ifi_Auftrag").Value & ".pdf"
End With
.Execute Pause:=False
If .DataSource.DataFields("Ableser_N").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
Zuletzt bearbeitet: