Hallo Micha,
einige der Richtext-Befehle funktionieren nur in Notes6
(da wir demnächst auf Lotus6Server und Client umstellen,
macht dies keine Probleme)!
Options public
Use "MailLibrary"
Sub Initialize
'declare local variables
Dim x As Integer
Dim y As Integer
Dim z As Integer
'Dim uiws As New notesuiworkspace
Dim newcollection As NotesDocumentCollection
Dim noteUIEditDocument As NotesUIDocument
Dim noteCursorDoc As NotesDocument
Dim vMailInfo As Variant
Dim body As NotesRichTextItem
Dim rtitem As NotesRichTextItem
Dim rtnav As NotesRichTextNavigator
Dim Anrede As String
'instantiate objects
InstantiateVariables
If Not collection Is Nothing Then
If (collection.Count = 0) Then
Messagebox "No documents were selected.",0,"Error"
Exit Sub
End If
Else
Exit Sub
End If
Redim SendToNames(collection.Count-1)
Redim SendToNachname(collection.Count-1)
Redim SendToBriefanrede(collection.Count-1)
'hier werden die Mailadressen,Nachname sowie Briefanrede aus meiner
' Datenbank ausgelesen(siehe auch "MailLibrary")!
'we use the GetNth method since the resulting collection is an IDTable
For x = 1 To collection.Count
Set note = collection.GetNthDocument(x)
SendToNames(counter) = GetMailAddress
SendToNachname(counter) = GetNachname
SendToBriefanrede(counter) = GetBriefanrede
counter = counter + 1
Next
'hier wird eine Vorlage aus einer Liste, welche sich in meiner Maildatenbank befindet geöffnet
vMailInfo = Evaluate( "@MailDbName" )
Set newcollection = ws.Picklistcollection(PICKLIST_CUSTOM, False, vMailInfo(0), vMailInfo(1), "Vorlage", "Vorlage wählen", "Wählen Sie bitte eine Vorlage für das neue Memo.")
Set mailnote = newcollection.getfirstdocument
'in der ersten Bodyzeile steht ein Wort, welches durch die Anrede ersetzt wird.
For y=0 To counter-1
Set body = mailnote.GetFirstItem("Body")
Set rtnav = body.CreateNavigator
Anrede = (SendToBriefanrede(y) + " " + SendToNachname(y) + ",")
rtnav.FindFirstElement(RTELEM_TYPE_TEXTPARAGRAPH)
Call body.BeginInsert(rtnav)
Call body.AppendText(Anrede)
Call body.AddNewLine(1)
Call body.EndInsert
mailnote.EnterSendTo = SendToNames(y)
mailnote.Logo = session.GetEnvironmentString("DefaultLogo",False)
mailnote.Principal = profile.Owner(0)
Call ws.EditDocument(True,mailnote)
Next
End Sub
--------------------------------------------------------------------------------------------------
"MailLibrary" in ScriptBibliotheken
Option Public
%INCLUDE "lsconst.lss"
(Declarations)
onst ERROR_TITLE = "Error"
Const ERROR_MSG_2 = "Please verify that it appears correctly in your current location."
Const ERROR_MSG_1 = "Your mail file could not be opened."
Dim ws As NotesUIWorkspace
Dim session As NotesSession
Dim db As NotesDatabase
Dim maildb As NotesDatabase
Dim note As NotesDocument
Dim mailnote As NotesDocument
Dim collection As NotesDocumentCollection
Dim profile As NotesDocument
Dim SendToNames() As String
Dim SendToNachname() As String
Dim SendToBriefanrede() As String
Dim counter As Integer
Dim flag As Variant
(InstantiateVariables)
Sub InstantiateVariables
Set ws = New NotesUIWorkspace
Set session = New NotesSession
Set db = session.CurrentDatabase
Set maildb = New NotesDatabase("","")
maildb.OpenMail
' check to make sure that we got the mail file opened
flag = maildb.Isopen
If flag = True Then
Set profile = maildb.GetProfileDocument("CalendarProfile")
counter = 0
Set collection = db.UnprocessedDocuments
Else
Msgbox ERROR_MSG_1 & Chr(13) & ERROR_MSG_2, MB_ICONSTOP,ERROR_TITLE
End If
End Sub
(GetMailAdress)
Function GetMailAddress() As String
GetMailAddress = note.EMail(0)
End Function
(GetNachname)
Function GetNachname() As String
GetNachname = note.Nachname(0)
End Function
(GetBriefanrede)
Function GetBriefanrede() As String
GetBriefanrede = note.Briefanrede(0)
End Function
