Serienbrief Bezug zu Datenquelle mit VBA
15.05.2019 09:20:09
Grouden
habe folgendes Problem:
Habe ein Serienbrief Dokument und eine Excel Datenquelle erstellt. Kann wie gewünscht die einzelnen Serienbrief Dokumente als PDF abspeichern.
Dazu setzte ich in der Empfängerliste in Word Haken bei den Empfängern, für die PDF Dateien erstellt werden sollen.
Allerdings kann ich hier immer nur alle von Anfang bis zur Stelle X auswählen und erstellen lassen. Wenn ich beliebe Datensätze auswähle, die nicht direkt hintereinander kommen und nicht beim ersten starten, dann kommt der Fehler:
Laufzeitfehler '5631':
Word konnte das Hauptdokument nicht mit der Datenquelle verbinden, da entweder die Datensätze leer waren oder kein Datensatz den Abfrageoptionen entsprach.
Ich würde aber gerne beliebe Daten ankreuzen um diese dann generieren zu lassen. Kann man nicht irgendwie das Fenster "Empfängerliste bearbeiten" ansprechen mit einer If Then Else Funktion und nur die angekreuzten Daten in der Datenquelle suchen lassen?
Vielen Dank für Eure Hilfe!
Hier mein Makro:
Sub SaveAsPDF(FilePath As String)
'Erstellung der PDF
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
FilePath, ExportFormat:= _
wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub
Sub JederDatensatzInEineEigenstandigeDatei()
Application.ScreenUpdating = False
Dim FeldVName, FeldNName, FeldXName, Pfad As String
FeldVName = "F7"
FeldNName = "F1"
FeldXName = "F6"
Pfad = "I:\Abteilung\ZET\Technik\05_Personen\Groten\Fachunternehmererklärung nach EnEV\ _
Serienbriefe PDF\"
With ActiveDocument.MailMerge
If .MainDocumentType = wdNotAMergeDocument Then
MsgBox "Das aktive Dokument ist kein Seriendruckhauptdokument."
Exit Sub
End If
.DataSource.ActiveRecord = wdLastRecord
anzahl = .DataSource.ActiveRecord
If anzahl = 0 Then
MsgBox "Die Datenquelle ist leer."
Exit Sub
End If
.Destination = wdSendToNewDocument
For i = 1 To anzahl
.DataSource.ActiveRecord = i
dsname = Pfad & _
.DataSource.DataFields(FeldVName).Value & "_" & .DataSource.DataFields(FeldXName) & "_" & . _
DataSource.DataFields(FeldNName) & ".pdf"
.DataSource.FirstRecord = i
.DataSource.LastRecord = i
.Execute
ActiveDocument.Range.Find.Execute FindText:="^b", replacewith:=""
SaveAsPDF (dsname)
ActiveDocument.Close (wdDoNotSaveChanges)
Next i
.DataSource.FirstRecord = 1
End With
Application.ScreenUpdating = True
End Sub
Anzeige