Erst im POSTSAVE-Event bist du wirklich sicher, wenngleich auch ein RTITEM.UPDATE bereits das Meiste abfragbar macht.
Ein Funktion wie die Folgende kann dann helfen:
Kurzversion:
Function IsRTitemEmpty( rtItem As NotesRichTextItem ) As Integer
Dim lEmptyFieldLength As Long
lEmptyFieldLength = 162 ' <<-------- set for your specific rt field!!!!!!
Dim rtnav As NotesRichTextNavigator
Dim elemType(1 To
As Long
Dim i As Integer
'---- any text?
If Trim$( rtItem.Text ) <> "" Then
IsRTitemEmpty = False
Exit Function
End If
'--- any detectible elements?
Set rtnav = rtItem.CreateNavigator
elemType(1) = RTELEM_TYPE_DOCLINK
elemType(2) = RTELEM_TYPE_FILEATTACHMENT
elemType(3) = RTELEM_TYPE_OLE
elemType(4) = RTELEM_TYPE_SECTION
elemType(5) = RTELEM_TYPE_TABLE
elemType(6) = RTELEM_TYPE_TABLECELL
elemType(7) = RTELEM_TYPE_TEXTPARAGRAPH
elemType(
= RTELEM_TYPE_TEXTRUN
For i = 1 To 8 Step 1
If rtnav.FindFirstElement( elemType(i)) Then
IsRTitemEmpty = False
Exit Function
End If
Next
'-- rt field longer than normal?
If rtItem.ValueLength > lEmptyFieldLength Then
IsRTitemEmpty = False
Exit Function
End If
IsRTitemEmpty = True
End Function
Langversion:
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
Gruß
Norbert
