MyExtractor Class (XML Extractor)

To create the class

1. On the Project menu, click Add Class Module.
2. In the Add Class Module dialog box, double-click Class Module.
3. On the View menu, select Properties Window.
4. In the Properties Window, for the Name property, type "MyExtractor".

To implement an interface

1. In the code window, type "Implements" and the name of the interface, for example:

   Implements IVBSAXContentHandler
   Implements IVBSAXErrorHandler
   Implements SAXXMLReader50
   Implements IVBSAXXMLFilter

2. In the left-hand drop-down list in the code window, select the interface.
3. In the right-hand drop-down list in the code window, you can implement the methods for the interface by selecting them from the list.

   Note   You must implement all methods for the implemented interfaces.

Complete Code for MyExtractor

Add the following code to the class.

Note   If you already added the Implements statements, you can simply copy the following code and paste it before the first Implements statement.

Option Explicit

Implements IVBSAXContentHandler
Implements IVBSAXErrorHandler
Implements SAXXMLReader50
Implements IVBSAXXMLFilter

Private parent As SAXXMLReader50
Private ch As IVBSAXContentHandler
Private strInvoiceNumber As String
Private putThrough As Boolean

Public cutElement As String

Public Sub IVBSAXContentHandler_characters(strChars As String)
    If Not IsEmpty(ch) And putThrough Then
        ch.characters strChars
    End If
End Sub

Public Property Set IVBSAXContentHandler_documentLocator(ByVal RHS As MSXML2.IVBSAXLocator)
End Property

Public Sub IVBSAXContentHandler_endDocument()
End Sub

Public Sub IVBSAXContentHandler_endElement(strNamespaceURI As String, strLocalName As String, strQName As String)
    
    Dim bld As MXXMLWriter50
    
    If Not IsEmpty(ch) Then
        If putThrough Then
            ch.endElement strNamespaceURI, strLocalName, strQName
        End If
        If strQName = cutElement Then
            ch.endDocument
            Set bld = ch 'Typecast the writer.
            putThrough = False
            Form1.processInvoice bld.output, strInvoiceNumber
            
        End If
    End If
End Sub

Public Sub IVBSAXContentHandler_endPrefixMapping(strPrefix As String)
    If Not IsEmpty(ch) And putThrough Then
        ch.endPrefixMapping strPrefix
    End If
End Sub

Public Sub IVBSAXContentHandler_ignorableWhitespace(strChars As String)
End Sub

Public Sub IVBSAXContentHandler_processingInstruction(strTarget As String, strData As String)
End Sub

Public Sub IVBSAXContentHandler_skippedEntity(strName As String)
End Sub

Public Sub IVBSAXContentHandler_startDocument()
    putThrough = False
End Sub

Private Sub IVBSAXContentHandler_startElement(strNamespaceURI As String, strLocalName As String, strQName As String, ByVal oAttributes As MSXML2.IVBSAXAttributes)
    If Not IsEmpty(ch) Then
        If strQName = cutElement Then
            Dim bld As Msxml2.MXXMLWriter50
            Set bld = ch ' typecast
            bld.output = New Msxml2.DOMDocument50
            putThrough = True
            ch.startDocument
            strInvoiceNumber = oAttributes.getValueFromName("", "number")
        End If
        If putThrough Then
            ch.startElement strNamespaceURI, strLocalName, strQName, oAttributes
        End If
    End If
End Sub

Public Sub IVBSAXContentHandler_startPrefixMapping(strPrefix As String, strURI As String)
    If Not IsEmpty(ch) And putThrough Then
        ch.startPrefixMapping strPrefix, strURI
    End If
End Sub

Private Sub IVBSAXErrorHandler_error(ByVal oLocator As MSXML2.IVBSAXLocator, strErrorMessage As String, ByVal nErrorCode As Long)
End Sub

Private Sub IVBSAXErrorHandler_fatalError(ByVal oLocator As MSXML2.IVBSAXLocator, strErrorMessage As String, ByVal nErrorCode As Long)
    MsgBox strErrorMessage & "  " & oLocator.lineNumber
End Sub

Private Sub IVBSAXErrorHandler_ignorableWarning(ByVal oLocator As MSXML2.IVBSAXLocator, strErrorMessage As String, ByVal nErrorCode As Long)
End Sub

Public Property Set IVBSAXXMLFilter_parent(ByVal RHS As MSXML2.SAXXMLReader50)
    Set parent = RHS
    Set RHS.contentHandler = Me
    Set RHS.errorHandler = Me
End Property

Public Property Get IVBSAXXMLFilter_parent() As Msxml2.SAXXMLReader50
    IVBSAXXMLFilter_parent = parent
End Property

Public Property Let SAXXMLReader50_baseURL(ByVal RHS As String)
    If Not IsEmpty(parent) Then
        parent.baseURL = RHS
    End If
End Property

Public Property Get SAXXMLReader50_baseURL() As String
    If Not IsEmpty(parent) Then
        SAXXMLReader50_baseURL = parent.baseURL
    End If
End Property

Public Property Set SAXXMLReader50_contentHandler(ByVal RHS As MSXML2.IVBSAXContentHandler)
    Set ch = RHS
End Property

Public Property Get SAXXMLReader50_contentHandler() As MSXML2.IVBSAXContentHandler
    SAXXMLReader50_contentHandler = ch
End Property

Public Property Set SAXXMLReader50_dtdHandler(ByVal RHS As MSXML2.IVBSAXDTDHandler)
End Property

Public Property Get SAXXMLReader50_dtdHandler() As MSXML2.IVBSAXDTDHandler
End Property

Public Property Set SAXXMLReader50_entityResolver(ByVal RHS As MSXML2.IVBSAXEntityResolver)
End Property

Public Property Get SAXXMLReader50_entityResolver() As MSXML2.IVBSAXEntityResolver
End Property

Public Property Set SAXXMLReader50_errorHandler(ByVal RHS As MSXML2.IVBSAXErrorHandler)
End Property

Public Property Get SAXXMLReader50_errorHandler() As MSXML2.IVBSAXErrorHandler
End Property

Private Function SAXXMLReader50_getFeature(ByVal strName As String) As Boolean
    If Not IsEmpty(parent) Then
        SAXXMLReader50_getFeature = parent.getFeature(strName)
    End If
End Function

Private Function SAXXMLReader50_getProperty(ByVal strName As String) As Variant
    ' Do not pass.
End Function

Public Sub SAXXMLReader50_parse(Optional ByVal varInput As Variant)
    If Not IsEmpty(parent) Then
        parent.parse varInput
    End If
End Sub

Public Sub SAXXMLReader50_parseURL(ByVal strURL As String)
    If Not IsEmpty(parent) Then
        parent.parseURL strURL
    End If
End Sub

Public Sub SAXXMLReader50_putFeature(ByVal strName As String, ByVal fValue As Boolean)
    If Not IsEmpty(parent) Then
        parent.putFeature strName, fValue
    End If
End Sub

Public Sub SAXXMLReader50_putProperty(ByVal strName As String, ByVal varValue As Variant)
    ' Do not pass.
End Sub

Public Property Let SAXXMLReader50_secureBaseURL(ByVal RHS As String)
    If Not IsEmpty(parent) Then
        parent.secureBaseURL = RHS
    End If
End Property

Public Property Get SAXXMLReader50_secureBaseURL() As String
    If Not IsEmpty(parent) Then
        SAXXMLReader50_secureBaseURL = parent.secureBaseURL
    End If
End Property

See Also

Extract Data From a Large Document | Overview of the XML Extractor Application | Application Forms (XML Extractor) | Sample Files (XML Extractor) | Run the Application (XML Extractor) | How the XML Extractor Application Works