okay klaro. Dachte vllt geht es auch ohne Code ... aber mit ist natürlich besser.
Es wird ein Dokument mitgegeben, welches die Werte für die Infomail beinhaltet. Daher kann dies vorher erstellt werden und erst später versendet. Hier der aktuelle Code, welcher dann die Email dann versendet. Die Adressaten werden aus Gruppen geholt.
Sub SendMail (infomail As NotesDocument)
On Error GoTo errorhandler
Const CURRENTMODULE = "Send Mail Routine"
' Subroutine to create email messages directly
' in the mail.box for router to deliver
Dim session As NotesSession
Dim ThisDb As NotesDatabase
Dim namesDB As NotesDatabase
Dim aLog As NotesLog
Dim agent As NotesAgent
Set session = New NotesSession
Set ThisDb = Session.CurrentDatabase
Set agent = Session.CurrentAgent
Dim theInstantV As Variant
Dim MailBoxDb As NotesDatabase
Dim Memobody As NotesRichTextItem
Dim object As NotesEmbeddedObject
'Create the document in MAIL.BOX on current server
Dim MyServer As String
Dim MyMailbox As String
MyServer = Session.CreateName(Session.GetEnvironmentString("mailserver", True)).Abbreviated
MyMailbox = "mail.box"
'Create the document in MAIL.BOX on current server
Set MailBoxDb = session.GetDatabase(MyServer, MyMailbox)
Dim memo As New NotesDocument(MailBoxDb)
'Convert recipients array into NAMES fields in Memo
Dim recip As New NotesItem(memo,"Recipients","info@info.com", NAMES)
Dim sendTo As New NotesItem(memo,"SendTo","info@info.com", NAMES)
Dim blindCopy As New NotesItem(memo,"BlindCopyTo", "info@info.com", NAMES)
' Make recip and sendTo Summary Fields. Failure to do so
' will prevent them appearing in view columns. If they
' don't appear in a view column ROUTER task will reject them.
recip.IsSummary = True
sendTo.IsSummary = True
blindCopy.IsSummary = True
'Sicherheitsabfrage:
Dim decission As String
decission = MsgBox ("Wollen Sie die Infomail versenden?",65, "Infomail versenden?")
If decission ="1" Then
Set MemoBody = memo.CreateRichTextItem( "Body" )
Dim rtitemB As Variant
Set rtitemB = infomail.GetFirstItem( "Body" )
Call MemoBody.Appendrtitem(rtitemB)
memo.Form = "Memo"
memo.From = infomail.From(0)
memo.Subject = infomail.Subject(0)
memo.MailFormat = "T"
memo.DeliveryPriority = "High"
memo.deliveryReport = "O"
'Namen aus Adressebuch holen und als Blindcopy hinzufügen
Set namesDB = New NotesDatabase("MeinServer/XY/Z","names.nsf")
Dim groupsView As NotesView
Dim groupsDC As NotesDocumentCollection
Set groupsView = namesDB.GetView("($Groups)")
'Alle Gruppen
Set groupsDC = groupsView.Getalldocumentsbykey("$bla_gruppe_")
Dim groupsDoc As NotesDocument
Set groupsDoc = groupsDC.GetFirstDocument
Dim recipientslist As Variant
Dim groups As Variant
groups = infomail.Groups
'ausgewählte Gruppen als Empfänger hinzufügen
'Durachlafuen aller Gruppendokumente
While Not (groupsDoc Is Nothing)
If groupsDoc.ListCategory(0) = "Oberkategorie" Then
'Obergruppe, die keine Mitglieder enthält
Set groupsDoc = groupsDC.getnextdocument(groupsDoc)
Else
'MsgBox groupsDoc.ListCategory(0)
'MsgBox groupsDoc.ListName(0) & ": " & groupsDoc.Members(0)
If groupsDoc.Members(0) = "" Then
'nichts machen, keine Mitglieder in den Gruppen
Else
'MessageBox "aktuelle Gruppe: "&groupsDoc.ListName(0)
ForAll x In groups
'Überprüfen ob, eine der ausgewählten Gruppen (x) in der aktuell geladenen Gruppe groupsDoc.ListName(0) ist
'Es werden auch die Untergruppen durchgegangen...
If x <> "" Then
If InStr(groupsDoc.ListName(0), x)>0 Then
'An diese gruppe soll versendet werden
'MsgBox "!"& x & " is equal " & groupsDoc.ListName(0)
recipientslist = groupsDoc.getItemValue("members")
infomail.SentTo = infomail.SentTo(0) & Join(recipientslist,",")
'Alle Member aus einer Gruppe in den Blindkopie machen:
Call blindCopy.Appendtotextlist(groupsDoc.getItemValue("members"))
Call recip.Appendtotextlist(groupsDoc.getItemValue("members"))
End If
End If
End ForAll
End If
Set groupsDoc = groupsDC.getnextdocument(groupsDoc)
End If
Wend
'zusätzliche Empfänger hinzufügen
Call blindCopy.Appendtotextlist(infomail.getItemValue("Reps"))
Call recip.Appendtotextlist(infomail.getItemValue("Reps"))
'Namen der zus. Empfänger auslesen
recipientslist = infomail.getItemValue("Reps")
infomail.SentTo = infomail.SentTo(0) & Join(recipientslist,",")
'Abschlißend Email versenden, nachdem der Inhalt erstellt wurde
Call memo.save(True,False)
theInstantV = Now
infomail.SentDate = "at " & theInstantV
infomail.Status = "sent"
Call infomail.save(True,False)
MsgBox "Die Infomail wurde versandt."
Else
infomail.SentDate = ""
infomail.Status = "unsend"
Call infomail.save(True,False)
MsgBox "Die Infomail wurde NICHT versandt."
End If
Exit Sub
errorhandler:
MsgBox(CURRENTMODULE+ Chr(13) +Error$+" on line "+Cstr(Erl()))
Exit Sub
End Sub