Hallo,

ersteiinmal ein hallo in die VBA Gemeinde. Ich persönlich bin leider nicht fit in diesem Thema und würde mich freuen, wenn mir hier geholfen werden kann.

Die Grundlage:

Ich habe ein Wordformular welches per Copy&Paste mit Daten befüllt wird. Durch das Drücken der Tastenkombination ALT+F12 wird folgende Aktion ausgeführt

- Das Dokument wird in ein PDF Dokument umgewandelt

- Das PDF Dokument wird umbenannt und gespeichert   (H:\Nachmeldungen\KW1-KW52 (je ein Ordner je Kalenderwoche) Dateiname: TG KUNDENNUMMER - DATUM

- Es öffent sich Outlook und das Dokument wird als Anlage eingefügt

- Die Betreffzeile ergibt sich aus einigen Datenfeldern aus dem Wordfformular (Nachmeldung Kd.Nr.: 00001, Tour: XXX, Name: XXXXX, XXX)

Die Veränderung:

Ich möchte das Dokument gern über eine Word-Seriendruckfunktion mit Kundendaten befüllen, damitt diese nicht immer per Copy&Paste einegfügt werden müssen.

Das Problem: 

- Ich habe es geschafft, das Word-Formular insoweit abzuändern, dass die Kundendaten (Name, Adresse, usw.) per Seriendruck eingespielt werden.

- Eigentlich habe ich in einem Ersten Schritt nur die Felder für Name, Strasse usw. verändert. Zu meinem Verständnis, müssten also in dem Originalcode nur die neuen Felder definiert werden (sagt man das so?)

- Die zweite Schwierigkeit bestand darin, dass ich nach dem Erstellen des Serienbriefes noch einige Formularfelder (bsw. Dropdown) befüllen möchte, was nur funktioniert, wenn das Dokument geschützt ist. Hier habe ich einen Code eingebaut, der das Dokument automatisch für die Bearbeitung einschränkt. 

Anlagen: https://1drv.ms/f/s!Ag7i9ul6eRl9yyOyU7x8TurL5dSZ

1. Originaldokument_Nachmeldung Menü (Passwort ist "2003")

2. Nachmeldung_Seriendruck_9.dotm

Apetito Nachmeldung_9.txt (Datensatzdatei für Sereindruck)

# Originalcode aus Dokument1

Sub Makro2()

Dim strKdNr
Dim strTour
Dim strName
Dim strVorName

Dim intKW
Dim strPfad
Dim strFilename

ActiveDocument.Content.Fields(1).Select
strKdNr = Trim(Selection.Text)
ActiveDocument.Content.Fields(2).Select
strTour = Selection.Text
ActiveDocument.Content.Fields(4).Select
strName = Selection.Text
ActiveDocument.Content.Fields(5).Select
strVorName = Selection.Text

If (Len(strKdNr) < 2) Then

    MsgBox ("Kundennummer ist leer!")
    
Else
    
    Set olapp = CreateObject("Outlook.Application")
    Set olitem = olapp.createitem(OlMailItem)
    
    olitem.Subject = "Nachmeldung Kd.Nr.: " & strKdNr & ", Tour: " & strTour & ", Name: " & strName & ", " & strVorName
    olitem.body = "siehe Anlage"
    olitem.to = "scberlin@apetito.de"
    
    intKW = Format$(Now, "ww", vbMonday, vbFirstFourDays)
    
    strPfad = "H:\Nachmeldungen\KW " & intKW & "\"
    strFilename = "TG " & strKdNr & " " & Format$(Now, "YYYY-mm-DD_HH-MM", vbMonday, vbFirstFourDays) & ".pdf"
    
    If (Dir(strPfad, vbDirectory) = "") Then
        MkDir (strPfad)
    End If
    
    'ActiveDocument.ExportAsFixedFormat(strPfad & strFilname, wdExportFormatPDF)
    
    ActiveDocument.ExportAsFixedFormat OutputFileName:=strPfad & strFilename, _
            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
    
    
    'ActiveDocument.ExportAsFixedFormat OutputFileName:="H:\temp\Info an Apetito.pdf", _
            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
    
    olitem.attachments.Add strPfad & strFilename
    olitem.Display
End If

End Sub

#Code zum Einschränken der Bearbeitung

Private Sub Formularfunktion_einschalten_Click()
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=""
End Sub

Ich Danke schon einmal im Vorraus :-)

Gruß Sven