Capture rich-text comments in Lotus Notes fields using LotusScript

There are many ways to capture comments in normal Lotus Notes text fields, but I needed to capture rich-text comments such as colors, different fonts, etc.

I didn't have to trim any comments, but I included the LotusScript code for that as a reference. I've found that you can capture rich-text comments using the NotesRichTextStyle class, which is available in Lotus Notes Domino 4.6 and higher.

Following is the LotusScript code I used on the QueryClose event.

Sub Queryclose(Source As 
Notesuidocument, Continue As Variant)
On Error Goto Oops
Dim db As NotesDatabase
Dim session As New NotesSession
Dim doc As NotesDocument
Set doc = session.CurrentDatabase.
GetDocumentByUNID(Source.Document.
UniversalID)

'Declare the rich text items 
Dim vNarrativeTemp As NotesRichTextItem
Dim vNarrative As NotesRichTextItem
Dim itemN As Variant


'set the rich text items 
itemN = doc.GetItemValue("NarrativeTemp")
Set vNarrativeTemp = doc.GetFirstItem
("NarrativeTemp")
Set vNarrative = doc.GetFirstItem("Narrative")

Dim richStyle As NotesRichTextStyle
Set richStyle = session.CreateRichTextStyle

'Narrative Field
If (itemN(0) <> "")Then  
richStyle.Bold = True
Call vNarrative.AppendStyle(richStyle)
Call vNarrative.AppendText(Format$(Now, 
"mm/dd/yy hh:nn AM/PM") & " by " & 
session.CommonUserName & ": ") 

 

 


  

   


    


   

   


    


     


      

       
 
        
 
         
 
          

           

            
Related resources from SearchDomino.com:
           
 
           

            
Tip: How to create a comments field for Lotus Notes documents 
Tip: Setting row colors by category in a Lotus Notes view 
Tutorial: 30 LotusScript tips 
LotusScript Reference Center
           
 
          
         
 
 
       
 
      
     


    


   

   


    


   

  
 


 
 
richStyle.Bold = False  
Call vNarrative.AddNewLine(1) 
Call vNarrative.AppendRTItem
(vNarrativeTemp)
Call vNarrative.AddNewLine(1) 
Call vNarrativeTemp.Remove
End If

'Save the doc 
Call doc.Save(True, False)
 
TheEnd:
Continue = True
Exit Sub
Oops:
 Resume TheEnd
End Sub

Sub TrimNotes(fixthis)
 t= fixthis
 trimmed = ""     
 found = "N"
'look for chr(13) or chr(10) and if 
found 'look for another and if found 
remove the second one
For x = 1 To Len(t)
'found the 1st CR or LF - accept it
If (Mid ( t , x , 1 ) = Chr(13) 
Or Mid ( t , x , 1 ) = Chr(10)) And found = "N" 
Then
 found = "Y"
trimmed =  trimmed & Chr(10)
 Goto getnext
  End If
'found a 2nd or subsequent 
CR or LF - throw it away
If (Mid ( t , x , 1 ) = Chr(13) Or
 Mid ( t , x , 1 ) = Chr(10)) 
And found = "Y" Then
 Goto getnext
End If
trimmed =  trimmed & Mid ( t , x , 1 )
found = "N"
getnext:
 Next
 t = trimmed     
'change double spaces to single space
a = "  "
b = " "
If (a<>b) Then 
 i=Instr(t,a)
 done=(i=0)
 While Not done
 t=Left(t,i-1)+b+Mid(t,i+Len(a))
 n=i+1
 i=Instr(n,t,a)
 If i=0 Then i=Instr(t,a)
 done=(i=0)
 Wend
 End If
'change // to /
 a = "//"
 b = "/"
 If (a<>b) Then 
 i=Instr(t,a)
 done=(i=0)
 While Not done
 t=Left(t,i-1)+b+Mid(t,i+Len(a))
 n=i+1
 i=Instr(n,t,a)
 If i=0 Then i=Instr(t,a)
 done=(i=0)
 Wend
 End If     
'change double hyphens -- to single -
 a = "--"
 b = "-"
 If (a<>b) Then 
 i=Instr(t,a)
 done=(i=0)
 While Not done
 t=Left(t,i-1)+b+Mid(t,i+Len(a))
 n=i+1
 i=Instr(n,t,a)
 If i=0 Then i=Instr(t,a)
 done=(i=0)
  Wend
 End If          
 fixthis = Trim(t)          

Do you have comments on this tip? Let us know.

This tip was submitted to the SearchDomino.com tip library by member Ron Sorrell. Please let others know how useful it is via the rating scale below. Do you have a useful Lotus Notes, Domino, Workplace or WebSphere tip or code snippet to share? Submit it to our monthly tip contest and you could win a prize.