ListServ for Domino.. hell why not..!
Category None
Ever wanted to make a LISTSERV for Domino...
Should be pretty easy.. Setup a user (for signing the agent) create a simple mail file and setup an agent that forwards messages.. simple...!
But what if you want it to make sure people sending to it are allowed to.... but what if you wanted it to also ignore bounce messages so it doesn't end up in an ugly routing loop..???
Ever wanted to make a LISTSERV for Domino...
Should be pretty easy.. Setup a user (for signing the agent) create a simple mail file and setup an agent that forwards messages.. simple...!
But what if you want it to make sure people sending to it are allowed to.... but what if you wanted it to also ignore bounce messages so it doesn't end up in an ugly routing loop..???
Here's some simple LotusScript code as a start. (Create an After Email Arrives agent)
You need to add a field into the CalendarProfile form called “members” make it multi-value and add in all the people who are going to receive email (and hence also authorised to send it.)
++++
Version 2
Changed to work as a scheduled agent looping through the inbox, wasn't reliable working on new docs or after mail arrives. Also added the persons email address to the top of the body field before sending. Not much of a change
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Messagebox "WGAgent Starting"
'GET PROFILE DOCUMENT
Messagebox "WGAgent Get Profile"
Dim profdoc As NotesDocument
Dim members As NotesItem
Dim stringmembers As String
Dim doc As NotesDocument
Dim view As NotesView
Set db = session.CurrentDatabase
Set profdoc = db.GetProfileDocument("CalendarProfile")
Set members = profdoc.GetFirstItem("members")
'Lets itterate through all the docs in the inbox, can reduce some load by moving processed docs to folders etc
Set view = db.GetView( "($Inbox)" )
Set doc = view.GetFirstDocument
While Not (doc Is Nothing)
If doc.hasitem("agenttag") Then
'Then lets ignore it
'Sometimes these event agents will double call a document, so lets just make sure
Messagebox "WGAgent Doc has already been processed so skipping"
Else
'Check from is one of the members or we dont resend\
Messagebox "WGAgent Checking valid SMTP Addy"
Dim smtpfrom As String
Dim smtpcheck As Integer
Dim nam As NotesName
Dim smtpfromNam As NotesName
If doc.HasItem( "SMTPOriginator" ) Then
'Its not from me
Set smtpfromNam = New NotesName (doc.SMTPOriginator(0))
Else
'Whoops from my notes addy
Set smtpfromNam = New NotesName ("matt@taet.com.au")
smtpcheck = True
End If
smtpfrom = smtpfromNam.Addr821
Forall member In members.Values
Set nam = session.CreateName( member )
stringmembers = stringmembers & ";" & nam.Addr821
If smtpfrom = nam.Addr821 Then
smtpcheck = True
End If
End Forall
If smtpcheck Then
'We are ok to continue
Else
doc.agenttag = "Error not allowed to send"
Call doc.Save(True,True)
Messagebox "WGAgent Sender was not authorised to send...!"
Exit Sub
End If
'Create new email
Messagebox "WGAgent Creating new email"
Dim subjectstr As String
Dim emaildoc As NotesDocument
Set emaildoc = New NotesDocument( db )
subjectstr = "GW: " & doc.subject(0)
emaildoc.subject = subjectstr
emaildoc.Form = "Memo"
Dim item As NotesItem
Dim tmpstring As String
tmpstring = "EMAIL FROM: " & smtpfrom
Dim rtitem As Variant
Set rtitem = New NotesRichTextItem ( emaildoc, "Body" )
Call rtitem.AppendText ( "+++============================+++")
Call rtitem.AddNewLine(1)
Call rtitem.AppendText ( tmpstring)
Call rtitem.AddNewLine(1)
Call rtitem.AppendText ( "+++============================+++")
Call rtitem.AddNewLine(1)
Set item = doc.GetFirstItem( "Body" )
Call rtitem.AppendRTItem( item )
Dim itembcc As NotesItem
Set itembcc = New NotesItem ( emaildoc, "BlindCopyTo","" )
Forall member In members.Values
Call itembcc.AppendToTextList( member )
End Forall
Call emaildoc.Send( False, )
doc.agenttag = "Done"
Call doc.Save(True,True)
End If
Set doc = view.GetNextDocument(doc)
Wend
Messagebox "WGAgent Finished"
End Sub
++++
Version 1
Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim collection As NotesDocumentCollection
Messagebox "WGAgent Starting"
'GET CURRENT EMAIL
Dim doc As NotesDocument
Set doc = session.DocumentContext
'GET PROFILE DOCUMENT
Messagebox "WGAgent Get Profile"
Dim profdoc As NotesDocument
Dim members As NotesItem
Dim stringmembers As String
Set db = session.CurrentDatabase
Set profdoc = db.GetProfileDocument("CalendarProfile")
Set members = profdoc.GetFirstItem("members")
Set collection = db.UnprocessedDocuments
Set doc = collection.GetFirstDocument
While Not (doc Is Nothing)
'Check from is one of the members or we dont resend\
Messagebox "WGAgent Checking valid SMTP Addy"
Dim smtpfrom As String
Dim smtpcheck As Integer
Dim nam As NotesName
Dim smtpfromNam As NotesName
If doc.HasItem( "SMTPOriginator" ) Then
'Its not from me
Set smtpfromNam = New NotesName (doc.SMTPOriginator(0))
Else
'Whoops from my notes addy.. so lets assume its ok
'Setting it up as a junk email its ignored anyway
Set smtpfromNam = New NotesName ("abc@123.com")
smtpcheck = True
End If
smtpfrom = smtpfromNam.Addr821
Forall member In members.Values
Set nam = session.CreateName( member )
stringmembers = stringmembers & ";" & nam.Addr821
If smtpfrom = nam.Addr821 Then
smtpcheck = True
End If
End Forall
If smtpcheck Then
'We are ok to continue
Else
Messagebox "WGAgent Sender was not authorised to send...!"
Exit Sub
End If
' Messagebox stringmembers,, "members strings"
'Create new email
Messagebox "WGAgent Creating new email"
Dim subjectstr As String
Dim emaildoc As NotesDocument
Set emaildoc = New NotesDocument( db )
subjectstr = "GW: " & doc.subject(0)
emaildoc.subject = subjectstr
emaildoc.Form = "Memo"
Dim item As NotesItem
Set item = doc.GetFirstItem( "Body" )
Call emaildoc.CopyItem( item, "Body" )
Dim itembcc As NotesItem
Set itembcc = New NotesItem ( emaildoc, "BlindCopyTo","" )
Forall member In members.Values
Call itembcc.AppendToTextList( member )
End Forall
Call emaildoc.Send( False, )
Set doc = collection.GetNextDocument (doc)
Wend
Messagebox "WGAgent Finished"
End Sub
=========================================================
The next phase is to setup so that people can subscribe and remove themselves via email or a webpage.
Not bad for a couple of hours really
