Hi All,
Has any one lotusscript to get only the richtext contents along with hotspot urls.
Subject: Here’s a thread in Notes 6/7 forum for you…
Covers this topic in some depth
Subject: Looking for parsing pardef and getting only text
Hi Wayne,
I am looking for parsing richtext field and getting text along with urllinks with lotusscript. I couldn’t find code for this.
Subject: It is explained in the link…
One of the posts there even got a link to more code.
Otherwise there is enough info in that thread for you to start.
Subject: export urllinks using dxl
Hope this is useful to someone
This is sending the RSS created temporary. This sends out RSS with the urllinks, hotspots
Option Public
Option Explicit
Dim domParser As NotesDOMParser
Dim BodyText1 As String
Dim hrefURL As String
Dim linkhere As Boolean
Dim Newline As String
Sub Initialize
On Error Goto Initialize_Err
Dim Session As New NotesSession
Dim CurrentDB As NotesDatabase
Dim NewsLookupView As NotesView
Dim NewsDoc As NotesDocument
Dim strxml As String
Dim FeedFileName As String
'Get a handle on the current database
Set CurrentDB = Session.CurrentDatabase
If Not(CurrentDB Is Nothing) Then
'Get a handle on the lookup view
Set NewsLookupView = CurrentDB.GetView("Live")
If Not(NewsLookupView Is Nothing) Then
'Ensure there are live news documents
Set NewsDoc = NewsLookupView.GetFirstDocument
If Not NewsDoc Is Nothing Then
'There is at least one news doc so can create the feed
strxml = |<?xml version="1.0" encoding="ISO-8859-1" ?>|
strxml = strxml + |<rss version="2.0"><channel>|
strxml = strxml + |<title>| + "test News" + |</title>|
strxml = strxml + |<link>| + "http://devserver.test.co.uk/main/test.nsf/testNews.rss" + |</link>|
strxml = strxml + |<description>| + "RSS created temporary for test News. This RSS is only used for populating the News" + |</description>|
strxml = strxml + |<pubDate>| + GetCurrentDate() + |</pubDate>|
'Loop through the live news articles and add them to the rss
While Not(NewsDoc Is Nothing)
strxml = strxml + |<item>|
strxml = strxml + |<title>| + EncodeText(NewsDoc.Title(0)) + |</title>|
strxml = strxml + |<description>| + GetBodyText(NewsDoc) + |</description>|
strxml = strxml + |<pubDate>| + GetPubDate(NewsDoc) + |</pubDate>|
'strxml = strxml + |<link>| + NewsDoc.WholeDocURL(0) + |</link>|
strxml = strxml + |<guid>http://test.co.uk/| + NewsDoc.UniversalID + |</guid>|
strxml = strxml + |</item>|
BodyText1=""
'Get the next news doc
Set newsDoc = newsLookupView.GetNextDocument(NewsDoc)
Wend
'Close down the rss feed text
strxml = strxml + |</channel></rss>|
'Output the feed to the browser
Print "Content-Type:application/rss+xml;charset='ISO-8859-1'"
Print strxml
End If
End If
End If
Initialize_Exit:
'Perform any neccessary clean up here
'Exit from the procedure
Exit Sub
Initialize_Err:
'Drop into debugger (if running)
Stop
'Report error
Print "Error" & Str(Err) & ": In Agent (Publish News) = " & Error$
'Gracefully exit
Resume Initialize_Exit
End Sub
Function EncodeText(OrigText As String) As String
On Error Goto EncodeText_Err
'Declare variables
Dim TextLength As Integer
Dim LoopCounter As Integer
Dim EncodedText As String
Dim CurrentChar As String
Dim EncodedChar As String
'Initalise variables
EncodedText = ""
'Deterine the length of text supplied
TextLength = Len(OrigText)
'Loop through the supplied string encoding chars if required
For LoopCounter = 1 To TextLength
'Get the current character
CurrentChar = Mid$(OrigText, LoopCounter, 1)
'Encode the current character (if required)
Select Case Asc(Currentchar)
Case 0 To 31 :
'No printable characters
EncodedChar = ""
Case 34:
'Double quote (")
EncodedChar = """
Case 38:
'Ampersand (&)
EncodedChar = "&"
Case 39:
'Single quote (')
EncodedChar = "'"
Case 60:
'Less than (<)
EncodedChar = "<"
Case 62:
'Greater than (>)
EncodedChar = ">"
Case 128 To 160:
'Dodgy Windows-1252 character (need to get appropriate generic char)
EncodedChar = GetCorrectedCode(Asc(currentchar))
Case Is > 160:
'Extended characters, use numerical value
EncodedChar = "&#" & Asc(Currentchar) & ";"
Case Else:
'Just use current char
EncodedChar = CurrentChar
End Select
'Append the encoded char to the encoded text
EncodedText = EncodedText & EncodedChar
Next
EncodeText_Exit:
'Perform any neccessary clean up here
'Return the encoded text
EncodeText = EncodedText
'Exit from the function
Exit Function
EncodeText_Err:
'Report error
Print "Error" & Str(Err) & ": In Procedure EncodeText() = " & Error$
'Gracefully exit
Resume EncodeText_Exit
End Function
Private Function GetBodyText(NewsDoc As NotesDocument) As String
On Error Goto GetBodyText_Err
'Declare variables
Dim Session As New NotesSession
Dim BodyField As NotesRichTextItem
Dim MimeContent As NotesMIMEEntity
Dim BodyText As String
Dim Title As String
Dim TypeValue As Integer
'Initalise variables
BodyText = ""
Session.ConvertMime = False
'Set Stream = session.CreateStream
'Ensure we have a valid news document
If Not(NewsDoc Is Nothing) Then
Title = GetTextFieldValue(NewsDoc, "Title")
%REM
'Extract the text from the body
BodyText=convertRichText(NewsDoc,"Body","")
%END REM
Dim exporter As NotesDXLExporter ' exports notes doc to XML code
Dim domParser As NotesDOMParser ' transforms XML code to a DOM tree
Dim importer As NotesDXLImporter ' imports XML code as notes document
Dim itemList As NotesDOMNodeList ' a list of <item>-nodes
Dim node As NotesDOMNode 'an <item> node
Dim aNode As NotesDOMAttributeNode 'a "name" attribute
Dim docNode As NotesDOMDocumentNode
Dim rootElement As NotesDOMElementNode
Dim rt As NotesRichTextItem
Dim eNode As NotesDOMElementNode
Dim docList As NotesDOMNodeList
Dim nodeChildOfRTOne As NotesDOMNode
Dim nodeChildRichText As NotesDOMNode
Dim parNode As NotesDOMElementNode
Dim i As Integer
Dim k As Integer
'Dim node As NotesDOMDocumentNode
Set exporter = session.CreateDXLExporter
Set domParser = session.createDOMParser
'set the NotesDocument as input for the exporter:
Call exporter.SetInput(NewsDoc)
'set the exporter as input and the rt as output for the domParser:
Call domParser.setInput(exporter)
Call domParser.SetOutput(NewsDoc)
Call exporter.process
'—
'get the list of elements:
Set docNode = domParser.Document
'Call walkTree(docNode, domParser)
Set rootElement = domParser.Document.DocumentElement
Set docList = rootElement.GetElementsByTagName ("item")
Dim element As NotesDOMElementNode
If docList.NumberOfEntries = 0 Then : Exit Function
For i = 1 To docList.NumberOfEntries
Set node = docList.GetItem( i )
Set enode = node
If enode.GetAttribute("name") = "Body" Then
If enode.hasChildNodes Then
Set nodeChildOfRTOne = enode.FirstChild
While Not (nodeChildOfRTOne.isNull)
If nodeChildOfRTOne.NodeName = "richtext" Then
If nodeChildOfRtOne.hasChildNodes Then
Set nodeChildRichText = nodeChildOfRTOne.FirstChild
While Not (nodeChildRichText.IsNull)
If nodeChildRichText.NodeName = "par" Then
Call walkTree(nodeChildRichText, domParser)
Else
End If
’ End If
’ End If
Set nodeChildRichText = nodeChildRichText.nextSibling
Wend
End If
End If
Set nodeChildOfRTOne = nodeChildOfRTOne.nextSibling
Wend
End If
End If
Next
NewLine = Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10)
'Msgbox BodyText1
'BodyText1=convertRichText(BodyText1)
BodyText1 = ReplaceSubString(BodyText1, Newline, "~NEWLINE~")
BodyText1 = ReplaceSubString(BodyText1, "~NEWLINE~", "</p><p>")
'Encode the returned text
BodyText1 = EncodeText(BodyText1)
'Msgbox BodyText1
'Fix any problems with the encoding
BodyText1 = ReplaceSubString(BodyText1, "&#", "&#")
'Msgbox BodyText1
End If
GetBodyText_Exit:
'Return the body text of the news doc
GetBodyText = BodyText1
'Exit from the function
Exit Function
GetBodyText_Err:
'Drop into debugger (if running)
Stop
'Report error
Print "Error" & Str(Err) & ": In Agent (Publish News)::GetBodyText() = " & Error$
'Gracefully exit
Resume GetBodyText_Exit
End Function
Function GetTextFieldValue(doc As NotesDocument, fieldName As String) As String
%REM
This function returns the contents of a named field on the supplied document
as text.
NOTES:
If the specified field does not exist on the documnet, an empty
string is returned.
There may be a need to add checking to ensure the field does
store data that can be represented as text.
HISTORY:
%END REM
On Error Goto GetTextFieldValue_Err
'Declare variables
Dim fieldValue As Variant
Dim returnString As String
'Initalise variables
returnString = ""
'Ensure a valid document has been supplied
If Not (doc Is Nothing) Then
'Ensure the document has the specified field
If doc.HasItem(fieldName) Then
'Get the fields contents
fieldValue = doc.GetItemValue(fieldName)
'Get the first string in the field
returnString = fieldValue(0)
End If
End If
GetTextFieldValue_Exit:
'Perform any neccessary clean up here
'Return the extract text value
GetTextFieldValue = returnString
'Exit from the function
Exit Function
GetTextFieldValue_Err:
'Report error
Print "Error" & Str(Err) & ": In Procedure NotesDocument::GetTextFieldValue = " & Error$
'Gracefully exit
Resume GetTextFieldValue_Exit
End Function
Function ConvertRichText(BodyText As String) As String
On Error Goto catch
’ Dim session As New NotesSession
Dim mText As String
’ Dim db As NotesDatabase
’ Dim newDoc As NotesDocument
’ Dim currentSessionMimeSetting As Integer
’ Dim rtitem As NotesRichTextItem
’ Dim body As NotesMIMEEntity
’ Dim header As NotesMIMEHeader
’ Dim stream As NotesStream
’ Dim MimeContent As NotesMIMEEntity
’ Dim BodyText As String
Dim Newline As String
NewLine = Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10)
'BodyText = GetTextFieldValue(ArticleDoc, "Body")
BodyText = ReplaceSubString(BodyText, Newline, "~NEWLINE~")
BodyText = EncodeText(BodyText)
BodyText = ReplaceSubString(BodyText, "~NEWLINE~", "</p><p>")
mText = "<p>" & BodyText & "</p>"
Goto finally
catch:
Print "Error" & Str(Err) & ": In Agent (Publish News)::ConvertRichText() = " & Error$
Resume finally
finally:
'Print "Returning : " & mText
ConvertRichText=mText
End Function
Function ReplaceSubString(Byval sourceString As String, originalSubString As String, newString As String ) As String
On Error Goto ReplaceSubString_Err
'Declare variables
Dim currentPosn As Integer
Dim startPosn As Integer
Dim sourceLength As Integer
Dim originalSubStringLength As Integer
Dim newSubStringLength As Integer
'Get length of "source" string
sourceLength = Len(sourceString)
'Get the length of sub-string to be changed
originalSubStringLength = Len(originalSubString)
'Get the length of the sub-string to be changed to
newSubStringLength = Len(newString)
'set start position in string to first character
startPosn = 1
'Check for any occurances of the sub-string to be changed
If Not ( Instr( 1, sourceString, originalSubString) = 0 ) Then
'continue as long as originalString is encountered in strSource
Do While Not (Instr(startPosn, sourceString, originalSubString) = 0)
'Get position of current occurance of originalString in strSource
currentPosn = Instr(startPosn, sourceString, originalSubString)
'replace strFrom w/ strTo
sourceString = Mid(sourceString, 1, currentPosn - 1 ) & newString & _
Mid(sourceString, currentPosn + originalSubStringLength, sourceLength)
'change start so we advance in strSource string
startPosn = currentPosn + newSubStringLength
Loop
End If
ReplaceSubString_Exit:
'Return new string
ReplaceSubString = sourceString
'Exit from the function
Exit Function
ReplaceSubString_Err:
'Report error
Msgbox "Error" & Str(Err) & ": In StringUtils::ReplaceSubString = " & Error$
'Gracefully exit
Resume ReplaceSubString_Exit
End Function
Function GetCorrectedCode(CharCode As Integer) As String
On Error Goto GetCorrectedCode_Err
'Declare variables
Dim CorrectedCode As String
'Initalise variables
CorrectedCode = ""
Select Case CharCode
Case 127 :
CorrectedCode= ""
Case 128 :
'Euro
CorrectedCode = "€"
Case 129 :
CorrectedCode= "�"
Case 130 :
'curved quote
CorrectedCode = "‚"
Case 131 :
CorrectedCode = "ƒ"
Case 132 :
CorrectedCode = "„"
Case 133 :
CorrectedCode = "…"
Case 134 :
CorrectedCode = "†"
Case 135 :
CorrectedCode = "‡"
Case 136 :
CorrectedCode = "ˆ"
Case 137 :
CorrectedCode = "‰"
Case 138 :
CorrectedCode = "Š"
Case 139 :
CorrectedCode = "‹"
Case 140 :
CorrectedCode = "Œ"
Case 141 :
CorrectedCode = "�"
Case 142 :
CorrectedCode = "Ž"
Case 143 :
CorrectedCode = "�"
Case 144 :
CorrectedCode = "�"
Case 145 :
CorrectedCode = "‘"
Case 146 :
CorrectedCode = "’"
Case 147 :
CorrectedCode = "“"
Case 148 :
CorrectedCode = "”"
Case 149 :
CorrectedCode = "•"
Case 150 :
CorrectedCode = "–"
Case 151 :
CorrectedCode = "—"
Case 152 :
CorrectedCode = "˜"
Case 153 :
CorrectedCode = "™"
Case 154 :
CorrectedCode = "š"
Case 155 :
CorrectedCode = "›"
Case 156 :
CorrectedCode = "œ"
Case 157 :
CorrectedCode = "�"
Case 158 :
CorrectedCode = "ž"
Case 159 :
CorrectedCode = "Ÿ"
Case 160 :
CorrectedCode = " "
Case Else:
'Just use current char
CorrectedCode = CharCode
End Select
GetCorrectedCode_Exit:
'Perform any neccessary clean up here
'Return the appropriate non windows specific character entitiy
GetCorrectedCode = CorrectedCode
'Exit from the function
Exit Function
GetCorrectedCode_Err:
'Drop into debugger (if running)
Stop
'Report error
Print "Error" & Str(Err) & ": In Agent (Publish News)::GetCorrectedCode() = " & Error$
'Gracefully exit
Resume GetCorrectedCode_Exit
End Function
Private Function GetPubDate(NewsDoc As NotesDocument) As String
On Error Goto GetPubDate_Err
'Declare variables
Dim PubDate As String
Dim DateModifiedField As NotesItem
Dim ModifiedDate As NotesDateTime
Dim LSModifiedDate As Variant
Dim dow(7) As String
Dim mon(12) As String
Dim RFC822Date As String
Dim TimeZone As String
'Initalise variables
RFC822Date = ""
'Assume we are in GMT
TimeZone = "GMT"
'Initalise days of week array
dow(1)="Sun"
dow(2)="Mon"
dow(3)="Tue"
dow(4)="Wed"
dow(5)="Thu"
dow(6)="Fri"
dow(7)="Sat"
'Initalise months of year array
mon(1)="Jan"
mon(2)="Feb"
mon(3)="Mar"
mon(4)="Apr"
mon(5)="May"
mon(6)="Jun"
mon(7)="Jul"
mon(8)="Aug"
mon(9)="Sep"
mon(10)="Oct"
mon(11)="Nov"
mon(12)="Dec"
'Ensure a valid news article has been supplied
If Not(NewsDoc Is Nothing) Then
'Get a handle on the date the article was last modified
Set DateModifiedField = NewsDoc.GetFirstItem( "ModDate" )
If Not(DateModifiedField Is Nothing)Then
'Get the date/time value the doc was last modified
Set ModifiedDate = DateModifiedField.DateTimeValue
'Flag if the modification done in British Summer time
If ModifiedDate.IsDST = True Then
'Flag that the doc was modified in BST
TimeZone = "+0100"
End If
LSModifiedDate = ModifiedDate.LSLocalTime
Else
'Just use the doc's last modified date time stamp
LSModifiedDate = NewsDoc.LastModified
End If
'Need to convert the date/time to RFC-822 format
RFC822Date = dow(Weekday(LSModifiedDate)) & ", " & Day(LSModifiedDate) & " " & _
mon(Month(LSModifiedDate)) & " " & Year(LSModifiedDate) & _
" " & Right("0" & Hour(LSModifiedDate),2) & ":" & Right("0" & Minute(LSModifiedDate),2) & _
":" & Right("0" & Second(LSModifiedDate),2) & " " & TimeZone
End If
GetPubDate_Exit:
'Perform any neccessary clean up here
'Return the date/time the doc was published
GetPubDate = RFC822Date
'Exit from the function
Exit Function
GetPubDate_Err:
'Drop into debugger (if running)
Stop
'Report error
Print "Error" & Str(Err) & ": In Agent (Publish News)::GetPubDate() = " & Error$
'Gracefully exit
Resume GetPubDate_Exit
End Function
Private Function GetCurrentDate() As String
On Error Goto GetCurrentDate_Err
'Declare variables
Dim CurrentDateTime As NotesDateTime
Dim LSCurrentDate As Variant
Dim dow(7) As String
Dim mon(12) As String
Dim TimeZone As String
Dim RFC822Date As String
'Initalise variables
RFC822Date = ""
'Assume we are in GMT
TimeZone = "GMT"
'Initalise days of week array
dow(1)="Sun"
dow(2)="Mon"
dow(3)="Tue"
dow(4)="Wed"
dow(5)="Thu"
dow(6)="Fri"
dow(7)="Sat"
'Initalise months of year array
mon(1)="Jan"
mon(2)="Feb"
mon(3)="Mar"
mon(4)="Apr"
mon(5)="May"
mon(6)="Jun"
mon(7)="Jul"
mon(8)="Aug"
mon(9)="Sep"
mon(10)="Oct"
mon(11)="Nov"
mon(12)="Dec"
'Get the current date/time
Set CurrentDateTime = New NotesDateTime("")
Call CurrentDateTime.SetNow()
'Determine if we are in BST
If CurrentDateTime.IsDST = True Then
'Set time zone for BST
TimeZone = "+0100"
End If
'Get the current lotusscript date time
LSCurrentDate = CurrentDateTime.LSLocalTime
'Need to convert the date/time to RFC-822 format
RFC822Date = dow(Weekday(LSCurrentDate)) & ", " & Day(LSCurrentDate) & " " & _
mon(Month(LSCurrentDate)) & " " & Year(LSCurrentDate) & _
" " & Right("0" & Hour(LSCurrentDate),2) & ":" & Right("0" & Minute(LSCurrentDate),2) & _
":" & Right("0" & Second(LSCurrentDate),2) & " " & TimeZone
GetCurrentDate_Exit:
'Perform any neccessary clean up here
'Return the date/time the doc was published
GetCurrentDate = RFC822Date
'Exit from the function
Exit Function
GetCurrentDate_Err:
'Drop into debugger (if running)
Stop
'Report error
Print "Error" & Str(Err) & ": In Agent (Publish News)::GetCurrentDate() = " & Error$
'Gracefully exit
Resume GetCurrentDate_Exit
End Function
Function walkTree ( node As NotesDOMNode, domParser As NotesDOMParser) As String
Dim child As NotesDOMNode
Dim numChildNodes As Integer
Dim nName As String
Dim NL As String 'carriage return + line feed
Dim eNode As NotesDOMElementNode
Dim parentnode As NotesDOMElementNode
Dim topparentnode As NotesDOMElementNode
Dim BodyText As String
NewLine = Chr$(13) & Chr$(10) & Chr$(13) & Chr$(10)
'Initalise variables
'BodyText = ""
'hrefURL = ""
'linkhere = False
NL = Chr(13)+Chr(10)
If Not node.IsNull Then
nName = CstrNodeType(node.NodeType)
'domParser.Output( nName+" " )
'Msgbox domParser.Document.DocumentElement.TagName
'Set eNode = node
'domParser.Output( "Tag name: "+eNode.Tagname+NL)
'Msgbox eNode.Tagname
Select Case node.NodeType
Case DOMNODETYPE_ELEMENT_NODE:
Set eNode = node
If eNode.Tagname = "urllink" Then
hrefURL= getAttributeText(eNode, "href")
If hrefURL <> "" Then
linkhere = True
'hrefURL = "<link>" + hrefURL + "</link>"
'Msgbox hrefURL
End If
End If
Case DOMNODETYPE_DOCUMENT_NODE: ' The Document node
' domParser.Output("Name: "+node.Nodename+NL)
'<a href="http://dx.doi.org/10.1038/458587a">doi:10.1038/458587a</a>
Case DOMNODETYPE_TEXT_NODE: ' The Document node
Set parentNode = node.ParentNode
If Not (parentNode.Tagname = "notesbitmap" Or parentNode.Tagname = "jpeg") Then
If linkhere = True Then
Set topparentnode = parentNode.ParentNode
If (topparentnode.Tagname ="urllink") Then
'BodyText1 = BodyText1 + "<" + node.NodeValue+">" +hrefURL
BodyText1 = BodyText1+ NewLine+ |<a href=" |+ hrefURL +|">| +node.NodeValue+|</a>|
linkhere = False
Else
'BodyText1 = BodyText1 +node.NodeValue +hrefURL
BodyText1 = BodyText1 +NewLine+ node.NodeValue
End If
Else
BodyText1 = BodyText1 + NewLine+ node.NodeValue
End If
End If
If node.ParentNode.IsNull Then
' domParser.Output(nName+"s have no parent")
Else
'BodyText1 = BodyText
'Messagebox "Node cannot have a parent!!", ,nName+" error"
Exit Function
End If
If node.NextSibling.IsNull And node.PreviousSibling.IsNull Then
' domParser.Output(" and no siblings"+NL )
Else
'BodyText1 = BodyText
'Messagebox "Node cannot have a sibling!!", ,nName+" error"
Exit Function
End If
Case Else:
' domParser.Output("Name: "+node.Nodename+NL)
If node.ParentNode.Isnull Then
' BodyText1 = BodyText
'Messagebox "Node must have a parent!!", ,nName+" error"
Exit Function
End If
If node.NextSibling.IsNull And node.PreviousSibling.IsNull Then
' domParser.Output(" has no siblings" )
Else
' domParser.Output(" has a sibling")
End If
End Select 'node.NodeType
If node.HasChildNodes Then
Set child = node.FirstChild
numChildNodes = node.NumberOfChildNodes
If node.NodeType = DOMNODETYPE_DOCUMENT_NODE Then
' domParser.Output(" has "+Cstr(numChildNodes) )
Else
' domParser.Output(" and "+Cstr(numChildNodes) )
End If
If numChildNodes = 1 Then
' domParser.Output( " child"+NL)
Else
' domParser.Output( " children"+NL)
End If
While numChildNodes > 0
Call walkTree(child, domParser)
Set child = child.NextSibling
numChildNodes = numChildNodes - 1
Wend
Else
’ domParser.Output(" and no children"+NL)
End If 'node.HasChildNodes
End If 'Not node.IsNull
End Function
Function CstrNodeType (currentNode As Long) As String
'Given a node type, convert it to a descriptive string.
Dim nodeCount(15) As Long
nodeCount(currentNode) = nodeCount(currentNode)+1
Select Case currentNode
Case DOMNODETYPE_ELEMENT_NODE: '1
CstrNodeType = "ELEMENT_NODE"
Case DOMNODETYPE_ATTRIBUTE_NODE: '2
CstrNodeType = "ATTRIBUTE_NODE"
Case DOMNODETYPE_TEXT_NODE: '3
CstrNodeType = "TEXT_NODE"
Case DOMNODETYPE_CDATASECTION_NODE: '4
CstrNodeType = "CDATASECTION_NODE"
Case DOMNODETYPE_ENTITYREFERENCE_NODE: '5
CstrNodeType = "ENTITYREFERENCE_NODE"
Case DOMNODETYPE_ENTITY_NODE: '6
CstrNodeType = "ENTITY_NODE"
Case DOMNODETYPE_PROCESSINGINSTRUCTION_NODE: '7
CstrNodeType = "PROCESSINGINSTRUCTION_NODE"
Case DOMNODETYPE_COMMENT_NODE: '8
CstrNodeType = "COMMENT_NODE"
Case DOMNODETYPE_DOCUMENT_NODE: '9
CstrNodeType = "DOCUMENT_NODE"
Case DOMNODETYPE_DOCUMENTTYPE_NODE: '10
CstrNodeType = "DOCUMENTTYPE_NODE"
Case DOMNODETYPE_DOCUMENTFRAGMENT_NODE: '11
CstrNodeType = "DOCUMENTFRAGMENT_NODE"
Case DOMNODETYPE_NOTATION_NODE: '12
CstrNodeType = "NOTATION_NODE"
Case DOMNODETYPE_XMLDECL_NODE: '13
CstrNodeType = "XMLDECL_NODE"
End Select
End Function
Function getAttributeText (node As NotesDOMNode, attrName As String) As String
'** get the text of a given attribute
Dim attrList As NotesDOMNamedNodeMap
Dim attr As NotesDOMNode
Dim attrValue As String
Dim i As Integer
If (node Is Nothing) Then
Exit Function
Elseif (node.IsNull) Then
Exit Function
End If
Set attrList = node.Attributes
For i = 1 To attrList.NumberOfEntries
Set attr = attrList.GetItem(i)
If (attr.NodeName = attrName) Then
attrValue = attr.NodeValue
End If
Next
getAttributeText = attrValue
End Function