Lotus Notes / Domino Sonstiges > Tipps und Tricks

Funktion um Mails zu erstellen mit LotusScript: "SendMails"

(1/1)

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)


--- Ende Code ---

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


--- Ende Code ---

Navigation

[0] Themen-Index