Makro um Serienbriefe als getrennte PDFs abzuspeicher mit korrektem Dokumentenamen

Hallo Ihr Lieben,


für die Arbeit muss ich häufiger bestimmte Dokumente mit für verschiedene empfänger mit den jeweiligen Namen, Adressen etc. anpassen.


Ich habe hierfür eine Excel liste erstellt und nutze diese für die Serienbrieffunktion in Word. Da ich teilweise über 20 Empfänger habe, ist es ziemlich aufwendig alles einzeln durchzuklicken und einzeln als PDF zu speichern, daher habe ich versucht mir ein Makro zu erstellen, damit die Briefe automatisch getrennt als PDFs mit den entsprechenden Dokumentenamen gespeichert werden.


Das speichern am richtigen Ort als PDF funktioniert schon mal sehr gut, jedoch passt der Dokumentenname noch nicht. Ideal wäre es, wenn der Dokumentenname aus dem Namen des Templates besteht z.B. "Unterschriftenseite" + der Nachname des Empfänger also z.B. so "Unterschriftenseite_Müller".


Bisher habe ich es nur geschafft, dass nur der Nachname im Dokumentennamen ist, aber der Name des Templates fehlt.


Vielleicht könntet ihr mir bei diesem Problem helfen. Leider kenne ich mich mit Makros gar nicht aus und es fällt mir schwer den Fehler zu finden


Hier ist der Makro den ich bis jetzt habe:






Sub BriefeTrennen3





Dim Dateiname As String

Dim LetzterRec As Long



Application.ScreenUpdating = False

Application.Visible = False



Const path As String = "C:\Users\bergmannsonja\Desktop\Aushilfe + BU\" 'Pfad anpassen

ActiveDocument.MailMerge.DataSource.ActiveRecord = wdLastRecord

LetzterRec = Word.ActiveDocument.MailMerge.DataSource.ActiveRecord

ActiveDocument.MailMerge.DataSource.ActiveRecord = wdFirstRecord





With ActiveDocument.MailMerge

.DataSource.ActiveRecord = wdFirstRecord

Do

If .DataSource.ActiveRecord > 0 Then

If .DataSource.DataFields"PI_Last_Name".Value <> "0" Then

.Destination = wdSendToNewDocument

.SuppressBlankLines = True



With .DataSource

.FirstRecord = .ActiveRecord

.LastRecord = .ActiveRecord



Dateiname = path & .DataFields"PI_Last_Name".Value & ".pdf"



End With

.Execute Pause:=False



ActiveDocument.SaveAs FileName:=Dateiname, FileFormat:=wdFormatPDF 'Speichern unter Dateiname

ActiveDocument.Close False

End If



End If



If .DataSource.ActiveRecord < LetzterRec Then

.DataSource.ActiveRecord = wdNextRecord

Else

Exit Do

End If

Loop

End With



Application.Visible = True

Application.ScreenUpdating = True



End Sub



Vielen Dank für eure Hilfe :