SNTT - Replacing tokens in Rich Text and preserving styles

A fairly common thing in Notes is to create a form with a Rich Text field so users can produce standard letters. To achieve this people often use tokens that later will be replaced in an agent, such as [DATE] or [ACCOUNT NAME]. Typically this is fairly easy, but there some instances where it gets tricky. What if you want the text that replaces a token to be in the same style as the token, such as a specific font, font size or color? And what about replacement text that spans multiple lines? Here is a function that will take care of it for you.

Sub ReplaceToken(Byval Token As String, Byval Replacement As String, _
RTBody As NotesRichTextItem, NewLineChar As String)
 Dim rtNav As NotesRichTextNavigator 
 Dim rtNavEnd As NotesRichTextNavigator
 Dim rtRange As NotesRichTextRange
 
 Dim linelength As Integer
 Dim oneline As String
 
 Set rtNav = RTBody.CreateNavigator
 Set rtRange = RTBody.CreateRange
 
 If rtNav.FindFirstString(Token) Then 
  'Mark the original token so you can delete it later
  Call rtRange.SetBegin(rtNav)
  Set rtNavEnd = rtNav.Clone
  Call rtNavEnd.SetCharOffset(Len(Token))
  Call rtRange.SetEnd(rtNavEnd)
  
  'Preserve the existing style.  This gets a little convoluted.
  '   1) The style is associated with a NotesRichTextRange.
  '   2) You have to BeginInsert before you can AppendStyle.
  Call RTBody.BeginInsert(rtNav)
  Call RTBody.AppendStyle(rtRange.Style)
  
  'Break up multiple lines (assumes a single character delimiter)
  linelength = Instr(1, Replacement, NewLineChar)
  Do Until linelength = 0
   oneline = Left$(Replacement, linelength - 1)
   Call RTBody.AppendText(oneline)
   Call RTBody.AddNewline(1)
   Replacement = Mid$(Replacement, linelength + 1)
   linelength = Instr(1, Replacement, NewLineChar)
  Loop   
  
  'Add the final line of replacement text, or the only line if there are
  '   not multiple lines of replacement text
  Call RTBody.AppendText(Replacement)
  Call RTBody.EndInsert
  
  'Delete the original token.
  Call rtRange.Remove  
 End If 
 
 Set rtRange = Nothing
 Set rtNav = Nothing
 Set rtNavEnd = Nothing
End Sub

This LotusScript was converted to HTML using the ls2html routine,
provided by Julian Robichaux at nsftools.com.

See, I do write code sometimes! :-)

SnTT , show-n-tell thursday