Hey super! Danke Axel! Endlich funktioniert das einfügen so wie es sein sollte.
Die Funktionalität ist jetzt absolut da und das ist das wichtigste. Wenns jetzt ohne große Umstände möglich ist dem Text noch eine Farbe zu geben dann wär das die Krönung. Sollte das mit viel Umstandskramerei verbunden sein dann vergess ich es wieder. Die fetten Zeilen zeigen wie ich mir das zusammengebastelt hätte. Aber der Text ist trotzdem immer schwarz.
Wie gesagt, wenns zu kompliziert ist sags einfach dann werd ichs vergessen.
Sub Click(Source As Button)
Dim wksp As New NotesUIWorkspace
Dim uidoc As NotesUIDocument, uidocNew As NotesUIDocument
Dim doc As NotesDocument
Dim rti As NotesRichTextItem
Dim rtnav As NotesRichTextNavigator
Dim bolEditMode As Boolean
Dim Message As String
Dim sess As New NotesSession
Dim strL As Integer
Dim UserN As String
Set uidoc = wksp.CurrentDocument
bolEditMode = uidoc.EditMode
If bolEditMode Then Call uidoc.Refresh (True) ' do this if the rich text field is editable, to get the current contents in case user has modified them.
Set doc = uidoc.Document
strL= Len(sess.UserName)-21
UserN = Right( Left(sess.UserName , 3+strL) , strL)
Message = Inputbox$( "Text für den neuen Statuseintrag:" , "neue Statusmeldung" )
Message = "< " & Now & " / " & UserN & " > " & Message
Set rti = doc.GetFirstItem("rtTest")
Set rtnav = rti.CreateNavigator
Dim richStyle As NotesRichTextStyle
Set richStyle = sess.CreateRichTextStyle
richStyle.NotesColor = COLOR_RED
Call rti.AppendStyle(richStyle)
If rtnav.FindFirstElement(RTELEM_TYPE_TEXTPARAGRAPH) Then
Call rti.BeginInsert(rtnav)
Call rti.AppendText( Message )
Call rti.AddNewLine( 2 )
Call rti.EndInsert
Else
Call rti.AddNewLine( 1 )
Call rti.AppendText( Message )
End If
Call rti.Update ' ND6 only
If Not bolEditMode Then Call doc.Save(True, False)
doc.SaveOptions = "0" ' make it possible to close the document without a "do you want to save" prompt.
Call uidoc.Close(True)
Set uidocNew = wksp.EditDocument(bolEditMode, doc, , , , True)
Delete uidoc
uidocNew.Document.RemoveItem("SaveOptions")
End Sub