Tuesday, November 23, 2010

Lotusscript code to append hotspot to a richtext field

My aim is to append a Link hotspot to the rich text field of a notes document as illustrated in the following image on a button click



The following code helped me perform the same
/***************************************************************************/
Function AppendHotspotLink (rtitem As NotesRichTextItem, url As String) As String
'** This function will attempt to append a button to a given
'** NotesRichTextItem, using code that has been assigned
'** to this object after it has been created (using the SetCode
'** method). The code language (as set with the SetLanguageType
'** method) can be either LotusScript or Formula language.

'** If there is an error creating the button (often because the code
'** doesn't compile correctly), this function will return the error
'** message. If the button is created properly, an empty string
'** will be returned.
On Error Goto processError

'** if no rich text item was given to us, just exit without doing anything
If (rtitem Is Nothing) Then
Exit Function
End If

Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim body As NotesRichTextItem
Dim importer As NotesDXLImporter

Dim buttonCode As String
Dim buttonTag As String
Dim dxl As String

'** set up the DXL to be used for the code in the button
%REM
If (buttonLanguage = RTB_LOTUSSCRIPT) Then
buttonCode = |<lotusscript>Sub Click(Source As Button)
| & XmlConvert(code) & |
End Sub</lotusscript>|
Else
buttonCode = |<formula>| & XmlConvert(code) & |</formula>|
End If



buttonTag = |<button width='2in' widthtype='fitcontent' wraptext='true' |
If (edgeType = RTB_SQUARE) Then
buttonTag = buttonTag & | edge='square' |
Else
buttonTag = buttonTag & | edge='rounded' |
End If
buttonTag = buttonTag & | bgcolor='system'>|
%END REM

'** DXL that will create a temporary doc with the button we want.
'** We're adding the current user name in an Author field on
'** this temporary document because we'll be deleting it at the end
'** of this function, and the user may only have Author access to
'** this database.
dxl = |<?xml version='1.0' encoding='ISO-8859-1'?>
<!DOCTYPE document SYSTEM 'xmlschemas/domino_8_5.dtd'>
<document xmlns='http://www.lotus.com/dxl' version='8.5.1'
 replicaid='0123456789ABCDEF' form='ButtonMaker'>
<item name='DocAuthor' authors='true' names='true'>
<text>| & XmlConvert(session.CommonUserName) & |</text></item>
<item name='Body'><richtext>
<pardef id="1" />
 <par def="1">
 <actionhotspot>
<code event="click">
  <formula>@URLOpen("|& url &|")</formula>
  </code>
  Document Link
  </actionhotspot>
  </par>
</richtext>
</item>
</document>|


'** create a new doc using the DXL above
Set db = session.CurrentDatabase
Set importer = session.CreateDXLImporter(dxl, db)
importer.ReplicaRequiredForReplaceOrUpdate = False
importer.DocumentImportOption = DXLIMPORTOPTION_CREATE
Call importer.Process

'** get the button from the doc we just created and append it to
'** the rich text item we were given
Set doc = db.GetDocumentByID(importer.GetFirstImportedNoteId)
Set body = doc.GetFirstItem("Body")
Call rtitem.AppendRTItem(body)

'** try to delete the temporary doc. In case we can't delete it for some
'** reason, a scheduled agent should be written to globally delete
'** docs that use the form name specified in the DXL above.
On Error Resume Next
Call doc.RemovePermanently(True)

Exit Function


processError:
If (importer.Log <> "") Then
AppendHotspotLink = importer.Log
Else
AppendHotspotLink = "Error " & Err & " on line " & Erl & ": " & Error$
End If
Exit Function
End Function




Function XmlConvert (txt As String) As String
'** get rid of the text characters that XML doesn't like (accented
'** characters are usually okay, as long as you use an encoding
'** like ISO-8859-1
XmlConvert = txt
XmlConvert = Replace(XmlConvert, "&", "&amp;")
XmlConvert = Replace(XmlConvert, "<", "&lt;")
XmlConvert = Replace(XmlConvert, ">", "&gt;")
End Function

Note: Use the following code to test the above function

%rem


Dim session As New NotesSession
Dim doc As NotesDocument
Dim rtitem As NotesRichTextItem

Dim result As String

'** grab the first selected doc in the view
Set doc = session.CurrentDatabase.UnprocessedDocuments.GetFirstDocument
Set rtitem = doc.GetFirstItem("Body")
If (rtitem Is Nothing) Then
Set rtitem = New NotesRichTextItem(doc, "Body")
End If

Call AppendHotspotLink(rtitem,"http://www.google.com")

'** save and exit
Call doc.Save(True, True)


%end rem

6 comments:

  1. If you need only a url link it may be sufficient to have

    (urllink showborder='false' href='mailto:|+url+|')(run)|+url+|(/run)(/urllink)

    (Replace () with <>)

    in the dxl code...

    Nice Tip, thank you!

    ReplyDelete
  2. Thank you for sharing. Will try it and post more when I find new stuffs with that. You idea is good too... :)

    ReplyDelete
  3. Very Cool Script! Does work perfectly.

    ReplyDelete
  4. Yes, indeed it helped me too. I have a query can we enter the hotspot somewhere inside a rich text meaning not just using/appending "Call rtitem.AppendRTItem(body)". I tried playing around it but can't find the right codes. Thanks.

    e.g.
    Rich Text = "I am a man"
    Hotspot = "super"

    New rich text = "I am a super man", where super is still a hotspot, tried using navigator and range but the hotspot is being removed.

    ReplyDelete
  5. Thanks for this script - it works really well. I only have one issue - when clicking on the hyperlink that is created I get an ECL alert on the URLOpen saying that there is no signature. Is there a way to sign the rich text field in this script?

    ReplyDelete
  6. I didn't quite answer my own question, but I did find a workaround.

    By replacing the with a I managed to avoid the ECL alert being triggered by the @URLOpen.

    ReplyDelete