MyExtractor Class (XML Extractor)
To create the class
- On the Project menu, click Add Class Module.
- In the Add Class Module dialog box, double-click Class Module.
- On the View menu, select Properties Window.
- In the Properties Window, for the Name property, type "MyExtractor".
To implement an interface
- In the code window, type "Implements" and the name of the interface, for example:
Implements IVBSAXContentHandler Implements IVBSAXErrorHandler Implements SAXXMLReader50 Implements IVBSAXXMLFilter
- In the left-hand drop-down list in the code window, select the interface.
- 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 theImplements
statements, you can simply copy the following code and paste it before the firstImplements
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