(Declarations)
Dim session As NotesSession
Dim db As NotesDatabase
Dim inputStream As NotesStream, outputStream As NotesStream
Dim domParser As NotesDOMParser
Dim inputNSF As String, origXML As String, reportFile As String
Dim message As String 'report title
Dim NL As String 'carriage return + line feed

REM The relevant structure of the XML file is:
REM <database...> the root element
REM <document form="Person">
REM <item name="attribute value">
REM <text>text value</text>
REM </item>
REM </document>
REM </database>

Sub Initialize
inputNSF = "c:\lotus\notes\data\names.nsf"
origXML = "c:\dxl\Contacts.xml"
reportFile = "c:\dxl\PhoneList.doc"

message = "Contacts Telephone List"
NL = Chr(13) + Chr(10)

Set session = New NotesSession
Call exportNames

If Not createFiles Goto closeUp

'create DOM parser and process
Set domParser=session.CreateDOMParser(inputStream, outputStream)
domParser.Process

'get the root element
Dim rootElement As NotesDOMElementNode
Set rootElement = domParser.Document.DocumentElement

'get all "Person documents"
Call getPersonDocs( rootElement )

outputStream.WriteText (NL + "Report created from:" + origXML + NL)

closeUp:
Call outputStream.Close
Messagebox "Report written to " + reportFile
End Sub

REM The relevant structure of the XML file is:
REM <document form="Person">...</document>
REM where,
REM document is an element node, member of documentList
REM form is an attribute name
REM and "Person" is the attribute's value
REM This is the "Person document" match we want

Sub getPersonDocs (node As NotesDOMElementNode)
'node is the root element of the xml file

Dim documentList As NotesDOMNodeList
Dim nDocument As Integer 'number of <document> elements
Dim i As Integer 'counter for documentList
Dim child As NotesDOMNode
Dim eNode As NotesDOMElementNode
Dim n As Integer 'number of attributes

If node.IsNull Then Exit Sub

Set documentList = node.GetElementsByTagName ("document")
nDocument = documentList.NumberOfEntries
If nDocument = 0 Then Exit Sub 'no document elements in file

REM Check the child nodes of the root element
Set child = node.FirstChild
For i = 1 To nDocument
While Not child.NodeName = "document"
Set child = child.NextSibling
Wend

REM We found an element node named "document"
If child.Attributes.NumberOfEntries > 0 Then

REM The node has attritubes
Set eNode = child 'switch to element node
For n = 1 To eNode.Attributes.NumberOfEntries
If eNode.GetAttribute("form") = "Person" Then

REM The node has the right attribute name and value
Call getData (eNode)
End If
Next
End If

REM Look for another Person document
Set child = child.NextSibling
Next

End Sub

REM The relevant structure of the XML file is:
REM <item name="attribute value">...</item>
REM where
REM item is an element node, member of itemList
REM name is an attribute name
REM "attribute value" is the attribute's value
REM This is one of the matches we're looking for

Sub getData (node As Notesdomelementnode)
'node is an element named "document"

Dim itemList As NotesDOMNodeList
Dim nItem As Integer 'number of <item> elements
Dim i As Integer 'counter for itemList
Dim child As NotesDOMNode
Dim eNode As Notesdomelementnode
Dim n As Integer 'number of attributes

If node.IsNull Then Exit Sub

Set itemList = node.GetElementsByTagName ("item")
nItem = itemList.NumberOfEntries
If nItem = 0 Then Exit Sub 'no item elements in node

REM Check the child nodes of this element
Set child = node.FirstChild
For i = 1 To nItem
While Not child.NodeName = "item"
Set child = child.NextSibling
Wend

REM We found an element node named "item"
If child.Attributes.NumberOfEntries > 0 Then

REM The node has attritubes
Set eNode = child 'switch to element node
For n = 1 To eNode.Attributes.NumberOfEntries

REM Look for an attribute named "name"
REM Only one of the following matches will be found for this node

If eNode.GetAttribute("name") = "FirstName" Then
REM We found a matching attribute value
domParser.Output (NL)
Call writeData (eNode)
n = eNode.Attributes.NumberOfEntries 'done with this node
End If

If eNode.GetAttribute("name") = "LastName" Then
REM We found a matching attribute value
domParser.Output (" ")
Call writeData (eNode)
domParser.Output (NL)
n = eNode.Attributes.NumberOfEntries 'done with this node
End If

If eNode.GetAttribute("name") = "OfficePhoneNumber" Then
REM We found a matching attribute value
domParser.Output (" ")
Call writeData (eNode)
domParser.Output (NL)
n = eNode.Attributes.NumberOfEntries 'done with this node
End If

Next 'continue searching for a matching attribute
End If

REM Look for another matching item
Set child = child.Nextsibling
Next

End Sub

REM The relevant structure of the XML file is:
REM <text>text value</text>
REM where
REM text is an element node, child of itemList member
REM text value is a text node, the textchild of itemList member
REM We want to print textchild.NodeValue in the report.

Sub writeData (node As NotesDOMNode)
'node is an element named "item"
'The text we want is actually in the "grandchild" of node

REM node.NodeName = item
REM child.NodeName = text
REM textchild.NodeType = DOMNODETYPE_TEXT_NODE
REM textchild.NodeValue = text value

Dim child As NotesDOMNode, textchild As notesDOMNode

Set child = node.FirstChild
If child.IsNull Then Exit Sub

Set textchild = child.FirstChild
If textchild.IsNull Then Exit Sub

domParser.Output( textchild.NodeValue )
End Sub

'Export the inputNSF file to the xml file origXML.
Sub exportNames

REM Create the xml file
Dim stream As NotesStream
Set stream = session.CreateStream
If Not stream.Open(origXML) Then
Messagebox "Cannot open " & origXML, , "Error"
Exit Sub
End If
Call stream.Truncate

REM Open the Notes database
Dim db As New NotesDatabase ("", "")
If Not db.Open ("", inputNSF) Then
Messagebox "Cannot open " & inputNSF, , "Error"
Exit Sub
End If

REM Create a note collection
Dim nc As NotesNoteCollection
Set nc = db.CreateNoteCollection(False)
Call nc.SelectAllNotes(True)
Call nc.SelectAllAdminNotes(False)
Call nc.SelectAllDesignElements(False)
Call nc.BuildCollection

REM Export note collection as DXL
Dim exporter As NotesDXLExporter
Set exporter = session.CreateDXLExporter
Call exporter.SetInput(nc)
Call exporter.SetOutput(stream)
Call exporter.Process
End Sub

Function createFiles
createFiles = True

'create the output file
Set outputStream = session.CreateStream
outputStream.Open (reportFile)
outputStream.Truncate

'write report title
outputStream.WriteText (message + NL)

'open the XML file
Set inputStream = session.CreateStream
inputStream.Open (origXML)
If inputStream.Bytes = 0 Then
Messagebox origXML + " is empty", , "Error"
createFiles = False
End If
End Function

関連項目

GetAttribute メソッド

用語集