MyExtractor Class (XML Extractor)

 

This topic describes how to use the MyExtractor class.

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 SAXXMLReader60
   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 SAXXMLReader60
Implements IVBSAXXMLFilter

Private parent As SAXXMLReader60
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 MXXMLWriter60
    
    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.MXXMLWriter60
            Set bld = ch ' typecast
            bld.output = New MSXML2.DOMDocument60
            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.SAXXMLReader60)
    Set parent = RHS
    Set RHS.contentHandler = Me
    Set RHS.errorHandler = Me
End Property

Public Property Get IVBSAXXMLFilter_parent() As MSXML2.SAXXMLReader60
    IVBSAXXMLFilter_parent = parent
End Property

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

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

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

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

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

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

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

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

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

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

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

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


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

End Sub

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

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

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

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

Public Property Get SAXXMLReader60_secureBaseURL() As String
    If Not IsEmpty(parent) Then
        SAXXMLReader60_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