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
|