Funktion um Mails zu erstellen mit LotusScript: "SendMails"

[cgorni]

Hier eine kleine Funktion, die mir gute Dienste geleistet hat. Durch eine kleine Erweiterung ist sie jetzt noch etwas universeller einsetzbar. Sie hilft beim Erstellen von Standard-Mails mit Hilfe von LotusScript.

Beispiel:

Code

Dim session As New NotesSession
Dim TextList List As String
Dim subject As String
Dim linkdoc As NotesDocument

SendTo		= "Adressat/MeineFirma"
subject 	                = "test"
Set linkdoc 	= session.CurrentDatabase.UnprocessedDocuments.GetFirstDocument

TextList("0")	= "Dies ist ein Text"
TextList("1")	= "Der Link ist hier <#> mitten im Satz"
TextList("2")	= "Ende"
	
Call SendMails(subject, SendTo, "", "", TextList, linkdoc, 0)

Erläuterung
---------------
- Der Link zum Dokument "linkdoc" wird an der Stelle des Flags "<#>" erstellt.
- Das Flag ist in der Funktion definiert, kann also zu etwas anderem geändert werden
- Man kann anstelle der "List of String" auch ein Array mit dem Textinhalt übergeben
- Jedes Element der "List of String" entspricht einer Zeile der Mail
- Leerzeilen können mit einem leeren Element (z.B. TextList("5") = "") erstellt werden

Erweiterungsmöglichkeiten
----------------------------------
- Hinzufügen von Parametern für "From" und "Principal" für das Anpassen des Absenders der Mail
- Erweiterung der Link-Möglichkeit um Ansichts- und Datenbanklinks (zwei neue Flags+Parameteränderung)
- Hinzufügen von Mailoptionen wie Lesebestätigung oder Priorität

Viel Spass beim benutzen.

[cgorni]

Code

Function SendMails(Subject As String, SendTo As Variant, CopyTo As Variant, BlindCopyTo As Variant, Text As Variant, linkdoc As NotesDocument, IconNumber As Integer) As Integer
	
	Const FLAG_LINKPOSITION		= "<#>"
	Const FIELD_MAILICON		= "_ViewIcon"
	Const FORM_MAIL			= "Memo"
	
	On Error Goto ErrorGeneral
	
	Dim session 	As New NotesSession 
	Dim mail 		As NotesDocument		
	Dim rtitem 	As NotesRichTextItem
	Dim isLinkIncluded 	As Boolean
	Dim beforelink 	As String
	Dim afterlink 	As String
	
'+++++++++++++++++++++++++++ BEGIN ++++++++++++++++++++++++++
	
	'------------------------------------------------------------
	' basic mail
	'------------------------------------------------------------
	Set mail = session.CurrentDatabase.CreateDocument
	
	mail.Form                 = FORM_MAIL
	mail.Subject	= Subject
	mail.CopyTo	= CopyTo
	mail.BlindCopyTo	= BlindCopyTo
	
	'mail.From		= ""
	'mail.Principal	= ""
	
	'------------------------------------------------------------
	' Icon in front of Mail in Inbox
	'------------------------------------------------------------
	If IconNumber <> 0 Then
		Call mail.AppendItemValue(FIELD_MAILICON, IconNumber)	
	End If
	
	'------------------------------------------------------------
	' Body field
	'------------------------------------------------------------
	Set rtitem = mail.CreateRichTextItem("Body")	' mail body
	Forall i In Text				' run through all given text lines
		Call rtitem.AddNewLine(1)		' carriage return for every new line
		
		If Instr(i, FLAG_LINKPOSITION) <> 0 And Not (linkdoc Is Nothing) Then	' does text line contain the link-flag?
			beforelink = Strleft(i, FLAG_LINKPOSITION)	' text in front of the link
			afterlink	= Strright(i, FLAG_LINKPOSITION)	' text after the link
			Call rtitem.AppendText(beforelink)
			Call rtitem.AppendDocLink(linkdoc,"")	' the link itself
			Call rtitem.AppendText(afterlink)
			isLinkIncluded 	= True		' don't insert the link again
			
		Else
			Call rtitem.AppendText(i)	' create the complete text line
			
		End If		
	End Forall
	
	'------------------------------------------------------------------
	' add link, when it is not done already
	'------------------------------------------------------------------
	If Not linkdoc Is Nothing And Not isLinkIncluded Then	
		Call rtitem.AppendDocLink(linkdoc,"")
	End If
	
	'------------------------------------------------------------------
	' send mail
	'------------------------------------------------------------------
	Call mail.Send(False, SendTo)
	Set mail = Nothing
	
	Goto ExitSub
	
'+++++++++++++++++++++++++++ END ++++++++++++++++++++++++++
ErrorGeneral:
'Enter your favourite error handling here	
	Resume ExitSub
	
ExitSub:
End Function