Hi Hab mal ein VB Script geschrieben, dass
a) die Wordformatierung behält und
b) sich vollständig in Word integriert als serien-email
Der Trick wie man die Formatierung von Word behält ist über die Zwischenablage zu gehen. Dazu muss man allerdings die Frontend-Klassen benutzen, was nicht gerade sonderlich schön ist.
Es funktioniert wie ein Serienbrief, Wordvorlage + Exceltabelle + klick auf Macro = Mails, die automatisch alle versendet werden. Eigentlich wollte ich noch ein schöneres Userinterface schreiben, aber dafür gab es bisher noch keine Zeit.
Also here we go:
~~~
Sub MailMergeToEmail()
Dim Email, Subject, PrevRecord, CCMail As Variant
Dim EmailField, CCMailField As Variant
Dim UseCC As Boolean
Dim EmailOk As Boolean
Dim MyMerge As MailMerge
Dim FieldList As String
Dim LNSession As Object
Dim LNWorkspace As Object
Dim LNMailServer As Variant
Dim LNMailDBName As Variant
Dim LNMail As Object
UseCC = False
EmailOk = False
Set MyMerge = ActiveDocument.MailMerge
'Prüfung ob eine gültige Datenquelle existiert
If Not (MyMerge.State = wdMainAndDataSource) Then
MsgBox ("Verarbeitung abgebrochen da keine Datenquelle existiert")
Exit Sub
End If
'Start von Lotus Notes abfrage vom Mailsserver, Mailfile
'und dem Benutzername
Set LNSession = CreateObject("Notes.NotesSession")
Set LNWorkspace = CreateObject("Notes.NotesUIWorkspace")
LNMailServer = LNSession.GETENVIRONMENTSTRING("MailServer", True)
LNMailDBName = LNSession.GETENVIRONMENTSTRING("MailFile", True)
LNUserName = LNSession.UserName
'Eine Liste aller verfügbarer Datenfelder wird zusammengestellt
'ausgenommen werden Autoseriendruckfelder, da sie keine gültigen Daten enthalten
FieldList = Chr(13) & Chr(10)
For Each afield In MyMerge.DataSource.FieldNames
If Not (afield.Name Like "AutoSeriendruckfeld*") Then
FieldList = FieldList & afield.Name & Chr(13) & Chr(10)
End If
Next afield
'definieren des Themas des Mailing
Subject = InputBox("Geben Sie das Thema für dieses Serienmailing ein", _
"Thema Serienmailing", _
"")
'festlegen des Feldes in der Datenquelle, dass als Empfänger Email-Adresse benutzt wird
ChooseEmailfield:
EmailField = InputBox("Geben Sie das Feld ein das die Emailadresse enthält" & Chr(13) & Chr(10) & _
"Folgende Felder stehen zur Verfügung :" & Chr(13) & Chr(10) & _
FieldList, _
"Senden An:", _
"")
'prüfen ob bei der Eingabe ein Fehler gmacht wurde, d.h. es wird geprüft,
'ob das Emailfeld tatsächlich existiert
For Each afield In MyMerge.DataSource.FieldNames
If afield.Name = EmailField Then
EmailOk = True
End If
Next afield
'bei einem Fehler wird zurück zur Emaileingabe gesprungen
If Not EmailOk Then
MsgBox ("Aus ausgewählte Felt existiert nicht")
GoTo ChooseEmailfield
End If
'festlegen des Feldes in der Datenquelle, dass als CC Mailadresse benutzt wird
CCMailField = InputBox("Geben Sie das Feld mit der Emailadresse für die Kopie an" & Chr(13) & Chr(10) & _
"Folgende Felder stehen zur Verfügung :" & Chr(13) & Chr(10) & _
FieldList, _
"Kopie AN: ", _
"")
If CCMailField = "" Then
UseCC = False
Else
UseCC = True
End If
PrevRecord = 0
MyMerge.DataSource.ActiveRecord = wdFirstRecord
MyMerge.ViewMailMergeFieldCodes = False
While MyMerge.DataSource.ActiveRecord <> PrevRecord
PrevRecord = MyMerge.DataSource.ActiveRecord
Email = MyMerge.DataSource.DataFields(EmailField).Value
If Email = "" Then
GoTo NextRecord
End If
If UseCC Then
CCMail = MyMerge.DataSource.DataFields(CCMailField).Value
Else
CCMail = ""
End If
Set LNMail = LNWorkspace.COMPOSEDOCUMENT(LNMailServer, LNMailDBName, "Memo")
Call LNMail.FIELDSETTEXT("Subject", Subject)
Call LNMail.FIELDSETTEXT("EnterSendTo", Email)
Call LNMail.FIELDSETTEXT("EnterCopyTo", CCMail)
Call LNMail.GOTOFIELD("Body")
ActiveDocument.Content.Copy
Call LNMail.Paste
Call LNMail.SEND
Call LNMail.Close(True)
For I = 1 To 40000
Next I
NextRecord:
MyMerge.DataSource.ActiveRecord = wdNextRecord
Wend
MyMerge.ViewMailMergeFieldCodes = True
Set LNMailMemo = Nothing
Set LNMailDD = Nothing
Set LNSession = Nothing
End Sub