OpenNTF Mail Template - Feature Request: Added disclaimer for outgoing smtp mail
We wish to have a disclaimer on all outgoing smtp mail but not on internal mail. For this I used code posted by Tom Kuczek from Corrigan & Associates Inc.
I added a Disclaimer field on the memo, reply and reply with history field and added the following code:
QuerySave:
Sub Querysave(Source As Notesuidocument, Continue As Variant)
Call Disclaimer
Call source.FieldSetText("useApplet", "True")
Call cMemoObject.QuerySave(Continue)
End Sub
Diclaimer code:
Sub Disclaimer
Dim WS As New NotesUIWorkspace
Dim UIDoc As NotesUIDocument
Dim Doc As NotesDocument
Dim BodyField As Variant
Dim SearchItem As Variant
Dim FieldList(2) As String
Dim SrchItem As NotesItem
Dim AtPos As Integer
Dim Text As String
Set UIDoc = ws.currentdocument
Set Doc = uidoc.document
Stop
Call UIDoc.GotoField("Body")
UIDoc.Refresh(True)
Forall Item In Doc.Items
If "Body" = Item.Name Then
'Print "got it!"
Set BodyField = Item
Exit Forall
End If
End Forall
If Instr (1, BodyField.Values, "DISCLAIMER: ", 5) Then
Exit Sub
Else
'Print "Text was not found in QS"
End If
FieldList(0) = "EnterSendTo"
FieldList(1) = "EnterCopyTo"
'FieldList(2) = "tmpEnterCopyTo"
FieldList(2) = "EnterBlindCopyTo"
Forall DocField In FieldList 'Search through each name field
Call UIDoc.GotoField(DocField)
UIDoc.Refresh
Set SearchItem = Doc.GetFirstItem(DocField)
Forall NameEntry In SearchItem.Values 'Search each name
Print NameEntry
AtPos = Instr(NameEntry, "@") 'Get the position of the @
If AtPos > 0 Then 'If "@" found then check for "."
If Instr(AtPos, NameEntry, ".") > 0 Then 'If "." is after @
Text = Doc.DisclaimerText(0) 'Put in a disclaimer...
If Text <> "" Then
Call UIDoc.FieldAppendText ("Body", Text)
Doc.DisclaimerText = ""
End If
Exit Sub 'If disclaimer added, get out
End If
End If
End Forall
End Forall
End Sub