Hi, 

Ich möchte aus einem Serienbrief einzelende Empfänger pdfs erstellen und diese benennen.

Das scheint nur mit Makros zu gehen, aber es klappt einfach nicht!

(Laufzeitfehler 4160: Set MainDoc = Documents("Beschissenes Makro_kein Serienbrief.docm")
Wer kann den Fehler in diesem Code finden? 

Const wdFirstRecord As Long = -6

Sub Serienbriefe_Fix_2026()
    Dim MainDoc As Document
    Dim DataRec As MailMergeDataSource
    Dim EinzelDoc As Document
    Dim DesktopPfad As String, ZielPfad As String
    Dim Nachname As String, Vorname As String, Ort As String, Objekt As String
    Dim Dateiname As String
    Dim i As Long
    Dim Limit As Long

    Set MainDoc = Documents("Beschissenes Makro_kein Serienbrief.docm")
    Set DataRec = MainDoc.MailMerge.DataSource

    Limit = 2
    If DataRec.RecordCount < Limit Then Limit = DataRec.RecordCount

    DesktopPfad = Environ("USERPROFILE") & "\Desktop\"
    ZielPfad = DesktopPfad & "Serienbriefe_PDFs_Test3\"
    If Dir(ZielPfad, vbDirectory) = "" Then MkDir ZielPfad

    Application.ScreenUpdating = False
    Application.DisplayAlerts = wdAlertsNone

    For i = 1 To Limit
        StatusBar = "Erzeuge PDF " & i & " von " & Limit & "..."
        DataRec.ActiveRecord = i

        Nachname = SafeGet(DataRec, "Name")
        Vorname = SafeGet(DataRec, "Vorname")
        Ort = SafeGet(DataRec, "Ort")
        Objekt = SafeGet(DataRec, "Objekt")

        If Trim(Nachname) = "" Then Nachname = "UNBEKANNT"
        If Trim(Vorname) = "" Then Vorname = "UNBEKANNT"

        Dateiname = Nachname & "_" & Vorname & "_" & Ort & "_" & Objekt
        Dateiname = SanitizeFilename(Dateiname) & ".pdf"

        MainDoc.MailMerge.Destination = wdSendToNewDocument
        MainDoc.MailMerge.DataSource.ActiveRecord = i
        MainDoc.MailMerge.Execute Pause:=False

        Set EinzelDoc = ActiveDocument

        EinzelDoc.ExportAsFixedFormat _
            OutputFileName:=ZielPfad & Dateiname, _
            ExportFormat:=wdExportFormatPDF, _
            OpenAfterExport:=False, _
            OptimizeFor:=wdExportOptimizeForPrint, _
            Range:=wdExportAllDocument, _
            Item:=wdExportDocumentContent, _
            IncludeDocProps:=True, _
            KeepIRM:=True, _
            CreateBookmarks:=wdExportCreateNoBookmarks, _
            DocStructureTags:=True, _
            BitmapMissingFonts:=True, _
            UseISO19005_1:=False

        EinzelDoc.Close SaveChanges:=False
        DoEvents
    Next i

    Application.ScreenUpdating = True
    Application.DisplayAlerts = wdAlertsAll
    StatusBar = False

    MsgBox Limit & " PDFs gespeichert unter:" & vbCrLf & ZielPfad, vbInformation
End Sub

Private Function SafeGet(ds As MailMergeDataSource, feld As String) As String
    On Error Resume Next
    SafeGet = ds.DataFields(feld).Value
    On Error GoTo 0
    If IsNull(SafeGet) Or SafeGet = "" Then
        SafeGet = ""
    End If
End Function

Private Function SanitizeFilename(ByVal s As String) As String
    Dim invalidChars As Variant, ch As Variant
    invalidChars = Array("/", "\", ":", "*", "?", """", "<", ">", "|")
    For Each ch In invalidChars
        s = Replace(s, ch, "_")
    Next ch
    s = Trim(s)
    Do While InStr(s, "  ") > 0
        s = Replace(s, "  ", " ")
    Loop
    SanitizeFilename = s
End Function