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

関連項目

Type プロパティ

用語集