Nur ausgefüllte Serienbriefe zu PDF zusammenfügen
01.04.2014 18:44:34
Isa
ich sitze mittlerweile den ganzen Tag am PC und habe mir vorgenommen auch nicht aufzustehen, bis ich für folgendes Problem eine Lösung habe:
Mit einem Makro in einem Excel-Dokument möchte ich in einem Word-Dokument einen Serienbrief erstellen, der direkt in eine PDF umgewandelt werden soll. Das klappt auch sehr gut. Doch ich erhalte stets eine PDF, welche alle möglichen Serienbriefe enthält, also auch solche, welche ich in Excel gar nicht ausgefüllt habe. Ist es möglich, dass nur die Briefe in der PDF erscheinen, welche auch ausgefüllt wurden?
Sub AbgleichmitDatenquelleundWordinPDFumwandeln()
'Verweis auf Microsoft Word 12.0 Object Library setzen
Dim WinWord, WinDoc As Word.Document, docSerienbrief As Word.Document
Dim oWrd As Object
Dim oDoc As Object
Dim strSheetName As String
strSheetName = "Tabelle1"
sdoc = ThisWorkbook.Path & "\1_Zeugnisse zum Ausdrucken.doc"
Set oWrd = CreateObject("word.application")
Set oDoc = oWrd.Documents.Open(sdoc)
oWrd.Visible = False
ActiveWorkbook.Save
With oDoc.MailMerge.MainDocumentType = wdFormLetters
oDoc.MailMerge.OpenDataSource Name:= _
ThisWorkbook.FullName _
, ConfirmConversions:=False, LinkToSource:=True, Connection:= _
"Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=" & ThisWorkbook. _
FullName & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Je" _
, SQLStatement:="SELECT * FROM `Datenübertragung$`", SQLStatement1:="", _
SubType:=wdMergeSubTypeAccess
oDoc.MailMerge.ViewMailMergeFieldCodes = wdToggle
'Serienbrief mit allen Daten in neuem Dokument erstellen
With oDoc.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
Dim strDateiname As String
Dim Pfad As String
Dim strPDF As String
Pfad = ActiveWorkbook.Path & "\Zeugnisse"
strPDF = Pfad
oWrd.ActiveDocument.ExportAsFixedFormat OutputFileName:=strPDF, ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=True, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
wdExportAllDocument, From:=1, To:=1, Item:=wdExportDocumentContent, _
IncludeDocProps:=True, KeepIRM:=True, CreateBookmarks:= _
wdExportCreateNoBookmarks, DocStructureTags:=True, BitmapMissingFonts:= _
True, UseISO19005_1:=False
End With
End With
oDoc.Close
oWrd.Quit SaveChanges:=wdDoNotSaveChanges
Set oWrd = Nothing
Set oDoc = Nothing
End Sub
Ich bin für jede Hilfe sehr dankbar!!!