Function Isrtempty(Uidoc As Notesuidocument, Rtname As String)
Function IsRTEmpty(UIDoc As NotesUIDocument, RTName As String)
Dim Doc As NotesDocument
Dim RTItem As NotesRichTextItem
IsRTEmpty = True
Set doc = uidoc.Document
'Push RichText Field Changes to Back End
Call uidoc.Refresh(True)
Set RTItem = Doc.GetFirstItem(RTName)
'Check For the presence of Text. If Found Exit Validation and display the text contents.
Dim Text As String
Text = RTItem.GetUnformattedText
'Now Remove Spaces, Tabs, NewLines from the text and
'check if there is any text remaining. If Yes, then it means
'that the field has passed the validation check. Otherwise
'be sure that there is no text present in the field, and check
'for the other possible contents i.e. Attachments etc...
Dim NonWhiteText As Variant
Dim Fr As String
Fr={@replacesubstring("}+Text+{";@Char(9):@Char(10):@Char(13):@Char(32) ;"")}
NonWhiteText = Evaluate(Fr)
If NonWhiteText(0) > "" Then
'Means there are some Non White Space characters present in the field.
IsRTEmpty = False
Exit Function
End If
Dim Nav As NotesRichTextNavigator
Set Nav = RTItem.CreateNavigator
'Check for the presence of table
If Nav.FindFirstElement(RTELEM_TYPE_TABLE ) Then
IsRTEmpty = False
Exit Function
End If
'Check for the presence of Doc Link/Db Link
If Nav.FindFirstElement(RTELEM_TYPE_DOCLINK ) Then
IsRTEmpty = False
Exit Function
End If
'Check for the presence of File Attachment
If Nav.FindFirstElement(RTELEM_TYPE_FILEATTACHMENT) Then
IsRTEmpty = False
Exit Function
End If
'Check for the presence of OLE Object
If Nav.FindFirstElement(RTELEM_TYPE_OLE ) Then
IsRTEmpty = False
Exit Function
End If
'Check for the presence of Section
If Nav.FindFirstElement(RTELEM_TYPE_SECTION ) Then
IsRTEmpty = False
Exit Function
End If
'Check For Pasted Images & Buttons
Dim DXLExp As NotesDXLExporter
Dim Parser As NotesDOMParser
Dim MainNode As NotesDOMDocumentNode
Dim RTItems As notesDOMNodeList
Dim RTNode As NotesDOMElementNode
Dim RTItemNode As NotesDOMElementNode
Dim PictureList As NotesDOMNodeList
Dim ButtonList As NotesDOMNodeList
Dim j As Integer
'Initialise Parser
Set Parser=session.CreateDOMParser
Set DXLExp = Session.CreateDXLExporter(Doc,Parser)
DXLExp.Process
Set MainNode = Parser.Document
' Get all Rich Text Fields
Set RTItems = MainNode.GetElementsByTagName( "richtext" )
For j = 1 To RTItems.NumberOfEntries
Set RTNode = RTItems.GetItem( j )
Set RTItemNode = RTNode.ParentNode
If Lcase(RTItemNode.GetAttribute("name")) = Lcase(RTName) Then
'Search For Picture Node
Set PictureList = RTItemNode.GetElementsByTagName("picture")
If PictureList.NumberOfEntries > 0 Then
IsRTEmpty = False
Exit Function
End If
‘Search for Buttons
Set ButtonList = RTItemNode.GetElementsByTagName("button")
If ButtonList.NumberOfEntries > 0 Then
IsRTEmpty = False
Exit Function
End If
End If
Next
End Function