by Kaustubh Zoal (10 Submissions)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Fri 21st June 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Sample XML File Processing by using msxml3.0 parser
API Declarations
'Copy the contents below to a XML file
XML FILE CONTENTS
-----------------
<?xml version="1.0"?>
<Person>
<Name>A</Name>
<Address>Pune</Address>
<State>Maharashtra</State>
<Name>B</Name>
<Address>Bombay</Address>
<State>Maharashtra</State>
<Name>C</Name>
<Address>Nagpur</Address>
<State>Maharashtra</State>
<Name>D</Name>
<Address>Kolhapur</Address>
<State>Maharashtra</State>
<Name>E</Name>
<Address>Baramati</Address>
<State>Maharashtra</State>
</Person>
This program parses the above given file and fills
a collection only with names.
VBcoders
'Class : IContentHandler.cls
Option Explicit
Implements IVBSAXContentHandler
Private m_oCollection As Collection
Private m_bAddInCollFlag As Boolean
Private m_sData As String
Private Sub IVBSAXContentHandler_characters(strChars As String)
If Not m_bAddInCollFlag Then Exit Sub
m_oCollection.Add m_sData & " : " & strChars
m_bAddInCollFlag = False
End Sub
Private Property Set IVBSAXContentHandler_documentLocator(ByVal RHS As MSXML2.IVBSAXLocator)
End Property
Private Sub IVBSAXContentHandler_endDocument()
End Sub
Private Sub IVBSAXContentHandler_endElement(strNamespaceURI As String, strLocalName As String, strQName As String)
End Sub
Private Sub IVBSAXContentHandler_endPrefixMapping(strPrefix As String)
End Sub
Private Sub IVBSAXContentHandler_ignorableWhitespace(strChars As String)
End Sub
Private Sub IVBSAXContentHandler_processingInstruction(strTarget As String, strData As String)
End Sub
Private Sub IVBSAXContentHandler_skippedEntity(strName As String)
End Sub
Private Sub IVBSAXContentHandler_startDocument()
End Sub
Private Sub IVBSAXContentHandler_startElement(strNamespaceURI As String, strLocalName As String, strQName As String, ByVal
oAttributes As MSXML2.IVBSAXAttributes)
If strLocalName = "Name" Then
m_bAddInCollFlag = True
m_sData = strLocalName
Else
m_bAddInCollFlag = False
End If
If oAttributes.length > 0 Then
DoEvents
Call GetAttributes(oAttributes)
End If
End Sub
Private Sub IVBSAXContentHandler_startPrefixMapping(strPrefix As String, strURI As String)
End Sub
'Used Attributes of the tag
Private Sub GetAttributes(ByVal oAttr As IVBSAXAttributes)
End Sub
Public Function GetAllNames() As Collection
Set GetAllNames = m_oCollection
End Function
Private Sub Class_Initialize()
Set m_oCollection = New Collection
m_bAddInCollFlag = False
End Sub
Private Sub Class_Terminate()
Set m_oCollection = Nothing
End Sub
'Class IErrorHandler.cls
Option Explicit
Implements IVBSAXErrorHandler
Private Sub IVBSAXErrorHandler_error(ByVal oLocator As MSXML2.IVBSAXLocator, strErrorMessage As String, ByVal nErrorCode As
Long)
MsgBox strErrorMessage
Debug.Print oLocator.columnNumber
Debug.Print oLocator.lineNumber
End Sub
Private Sub IVBSAXErrorHandler_fatalError(ByVal oLocator As MSXML2.IVBSAXLocator, strErrorMessage As String, ByVal nErrorCode
As Long)
MsgBox strErrorMessage
Debug.Print oLocator.columnNumber
Debug.Print oLocator.lineNumber
End Sub
Private Sub IVBSAXErrorHandler_ignorableWarning(ByVal oLocator As MSXML2.IVBSAXLocator, strErrorMessage As String, ByVal
nErrorCode As Long)
MsgBox strErrorMessage
Debug.Print oLocator.columnNumber
Debug.Print oLocator.lineNumber
End Sub
Form : Form1
Option Explicit
Dim m_oIContent As IContentHandler
Dim m_oIError As IErrorHandler
Dim m_oReader As SAXXMLReader30
Dim m_oNameCollection As Collection
Private Sub cmdProcessXML_Click()
With m_oReader
Set .contentHandler = m_oIContent
Set .errorHandler = m_oIError
.parseURL App.Path & "\Sample.xml"
End With
Set m_oNameCollection = m_oIContent.GetAllNames
End Sub
Private Sub Form_Load()
Set m_oNameCollection = New Collection
Set m_oIContent = New IContentHandler
Set m_oIError = New IErrorHandler
Set m_oReader = New SAXXMLReader30
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set m_oIContent = Nothing
Set m_oIError = Nothing
Set m_oReader = Nothing
Set m_oNameCollection = Nothing
End Sub