LOTUSSCRIPT/COM/OLE CLASSES
Dim session As NotesSession Dim db As NotesDatabase Dim dc As NotesDocumentCollection Dim doc As NotesDocument Dim body As NotesRichTextItem Dim rtnav As NotesRichTextNavigator Dim elemType(1 To 8) As Long Sub Initialize Set session = New NotesSession Set db = session.CurrentDatabase Set dc = db.UnprocessedDocuments If dc.Count = 0 Then Messagebox "No document selected",, "No doc" Exit Sub End If Set doc = dc.GetFirstDocument Set body = doc.GetFirstItem("Body") Set rtnav = body.CreateNavigator Dim rtrange As NotesRichTextRange Set rtrange = body.CreateRange 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(8) = RTELEM_TYPE_TEXTRUN For i = 1 To 8 Step 1 If rtnav.FindFirstElement(elemType(i)) Then Do Call rtrange.SetBegin(rtnav) Call DisplayRange(rtrange) Loop While rtnav.FindNextElement(elemType(i)) Else Messagebox "No element of this type in Body",, _ "No " & GetTypeString(elemType(i)) End If Next End Sub Sub DisplayRange(rtrange As NotesRichTextRange) Select Case rtrange.Type Case RTELEM_TYPE_TEXTPARAGRAPH Messagebox rtrange.TextParagraph,, "Text paragraph" Case RTELEM_TYPE_TEXTRUN Messagebox rtrange.TextRun,, "Text run" Case Else Messagebox "< >",, GetTypeString(rtrange.Type) End Select End Sub Function GetTypeString(elemType As Long) As String Select Case elemType Case RTELEM_TYPE_DOCLINK GetTypeString = "Doc link" Case RTELEM_TYPE_FILEATTACHMENT GetTypeString = "File attachment" Case RTELEM_TYPE_OLE GetTypeString = "OLE object" Case RTELEM_TYPE_SECTION GetTypeString = "Section" Case RTELEM_TYPE_TABLE GetTypeString = "Table" Case RTELEM_TYPE_TABLECELL GetTypeString = "Table cell" Case RTELEM_TYPE_TEXTPARAGRAPH GetTypeString = "Text paragraph" Case RTELEM_TYPE_TEXTRUN GetTypeString = "Text run" End Select End Function
See Also