Greetings,
I use the following code in a document with a richtext field called “Email”. The code prompts user to choose an email from her/his inbox and the code adds the content of the email in a section in the “Email” rich text field. This usually works fine however sometimes in some documents after adding few emails, when you try to add more it seems to process but does not show the new emails in rich text field. I would appreciate if anybody could help with this issue. Thanks in advance
Sub Click(Source As Button)
Dim sess As NotesSession
Set sess = New notessession
Dim ws As New NotesUIWorkspace
Dim projectdb As NotesDatabase
Set projectdb = sess.CurrentDatabase
Dim olduidoc As notesuidocument
Set olduidoc = ws.CurrentDocument
If olduidoc.IsNewDoc = True Then
Dim s As Integer
s = ws.Prompt(PROMPT_YesNo, "Project is not saved", "You must save the project before you can perform this action. Do you want to save the project now?")
If s = 1 Then
Call olduidoc.Save
Else
Exit Sub
End If
End If
Dim currentdoc As notesdocument
Set currentdoc = olduidoc.Document
Dim reg As NotesRegistration
Set reg = New NotesRegistration
Dim username As String
username = sess.UserName
Dim user As NotesName
Set user = sess.CreateName(username)
Call reg.GetUserInfo(username,,mailfile$,,,)
Dim db As notesdatabase
Set db = sess.GetDatabase("",mailfile$)
Dim filename As String
filename =db.Filepath
Dim mail As NotesDocumentcollection
Set mail = ws.PickListCollection(Picklist_Custom,False, "",filename,"($All)","Please select an email","Please select emails you want to insert in project history")
If mail.Count = 0 Then
Exit Sub
End If
Dim maildoc As notesdocument
Set maildoc = mail.GetFirstDocument
Dim tempdoc As NotesDocument
Set tempdoc = db.CreateDocument
Dim secondrt As NotesRichTextItem
Set secondrt = New NotesRichTextItem(tempdoc,"b")
'getting the name from the maildoc's "from" field
Dim nam As NotesName
Set nam = sess.CreateName(maildoc.From(0))
Call maildoc.RenderToRTItem(secondrt)
Dim nitem As Variant
Set nitem = currentdoc.GetFirstItem("Email")
Dim rt As NotesRichTextItem
If ( nitem.Type = RICHTEXT ) Then
Set rt = nitem
Call rt.Update
Call rt.BeginSection("Email from " & nam.Common & " sent on: " & maildoc.posteddate(0) & " Subject: " & maildoc.Subject(0) )
Call rt.AppendRTItem(secondrt)
Call rt.EndSection
Call rt.Update
End If
currentdoc.SaveOptions = "0"
Call olduidoc.Close(True)
Dim newuidoc As notesuidocument
Set newuidoc = ws.EditDocument(True, currentdoc)
Delete olduidoc
Set currentdoc = newuidoc.Document
newuidoc.gotofield("ProjectHistory")
Call currentdoc.RemoveItem( "SaveOptions" )
End Sub