Hallo Hier mein komplettes skript
Sub Querysave(Source As Notesuidocument, Continue As Variant)
Dim session As New NotesSession
Dim db As NotesDatabase
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim senddoc As NotesDocument
Dim item As NotesItem
Dim rtitem As NotesRichTextItem
Dim collection As NotesDocumentCollection
Dim Teamlead As String
Set db = session.CurrentDatabase
Set uidoc = ws.CurrentDocument
Set doc = uidoc.Document
Set senddoc = New NotesDocument(db)
Set collection = db.AllDocuments
Set doc = collection.GetFirstDocument()
While Not(doc Is Nothing)
If doc.HasItem ("TeamLeader") Then
If doc.HasItem ("Form") Then
Teamlead = Cstr (doc.Teamleader(0))
End If
End If
Set doc = collection.GetNextDocument(doc)
Wend
DueDateStatus = uidoc.FieldGetText("DueDateStatus")
OldDueDateStatus = uidoc.FieldGetText("OldDueDateStatus")
If OldDueDateStatus = "" Then
Call uidoc.FieldSetText("OldDueDateStatus", DueDateStatus)
Goto ende
End If
If DueDateStatus <> OldDueDateStatus Then
Call uidoc.FieldSetText("OldDueDateStatus", DueDateStatus)
senddoc.form = "Memo"
senddoc.Subject = "Status Change" & " " & db.Title
'Anlegen und füllen des Richtextfeldes für die Aufgabenbeschreibung
Set rtitem = senddoc.CreateRichTextItem("Body" )
Subject = uidoc.FieldGetText("Subject")
Call rtitem.AppendText("The Status was changed in document " &"/ " & Subject & " \" &" ")
Call rtitem.AppendDocLink(doc, db.Title) ' Documenten link anlegen
Call senddoc.send (True,Teamlead)
End If
ende:
End Sub
Ich hoffe das euch das weiter hilft.
Weiterhin hoffe ich das ich nicht wieder aus dummheit was übersehen habe.