Вы можете попробовать использовать SAX вместо DOM.SAX должен работать быстрее, когда все, что вы делаете, это анализ документа, а документ имеет нетривиальный размер.Ссылка для реализации SAX2 в MSXML: здесь
Я обычно обращаюсь непосредственно к DOM для большинства операций синтаксического анализа XML в Excel, но SAX, кажется, имеет преимущества в некоторых ситуациях.Краткое сравнение здесь может помочь объяснить различия между ними.
Вот взломанный пример (частично основанный на this ), просто использующий Debug.Print для вывода:
Добавьте ссылку на «Microsoft XML, v6.0» через Сервис> Ссылки
Добавьте этот код в обычный модуль
Option Explicit
Sub main()
Dim saxReader As SAXXMLReader60
Dim saxhandler As ContentHandlerImpl
Set saxReader = New SAXXMLReader60
Set saxhandler = New ContentHandlerImpl
Set saxReader.contentHandler = saxhandler
saxReader.parseURL "file://C:\Users\foo\Desktop\bar.xml"
Set saxReader = Nothing
End Sub
Добавьте модуль класса,назовите его ContentHandlerImpl и добавьте следующий код
Option Explicit
Implements IVBSAXContentHandler
Private lCounter As Long
Private sNodeValues As String
Private bGetChars As Boolean
. Используйте раскрывающийся список слева вверху модуля, чтобы выбрать «IVBSAXContentHandler», а затем используйте раскрывающийся список справа, чтобы добавитьзаглушки для каждого события по очереди (от characters до startPrefixMapping)
Добавьте код для некоторых заглушек следующим образом
Явно установите счетчик и флаг, чтобы показать, если мы хотимдля чтения текстовых данных в это время
Private Sub IVBSAXContentHandler_startDocument()
lCounter = 0
bGetChars = False
End Sub
Каждый раз, когда запускается новый элемент, проверяйте имя элемента и предпринимайте соответствующие действия
Private Sub IVBSAXContentHandler_startElement(strNamespaceURI As String, strLocalName As String, strQName As String, ByVal oAttributes As MSXML2.IVBSAXAttributes)
Select Case strLocalName
Case "Row"
sNodeValues = ""
Case "Col"
sNodeValues = sNodeValues & "|" & oAttributes.getValueFromName(strNamespaceURI, "id") & ":"
bGetChars = True
Case Else
' do nothing
End Select
End Sub
Проверьте, не интересует ли настекстовые данные и, если мы, отрубить любой посторонний пробелd удалите все переводы строк (это может или не может быть желательно в зависимости от документа, который вы пытаетесь проанализировать)
Private Sub IVBSAXContentHandler_characters(strChars As String)
If (bGetChars) Then
sNodeValues = sNodeValues & Replace(Trim$(strChars), vbLf, "")
End If
End Sub
Если мы достигли конца Col, тогда прекратите чтение текстовых значений;если мы достигли конца Row, то распечатаем строку значений узлов
Private Sub IVBSAXContentHandler_endElement(strNamespaceURI As String, strLocalName As String, strQName As String)
Select Case strLocalName
Case "Col"
bGetChars = False
Case "Row"
lCounter = lCounter + 1
Debug.Print lCounter & " " & sNodeValues
Case Else
' do nothing
End Select
End Sub
Чтобы прояснить ситуацию, вот полная версия ContentHandlerImpl со всеми заглушкамиметоды на месте:
Option Explicit
Implements IVBSAXContentHandler
Private lCounter As Long
Private sNodeValues As String
Private bGetChars As Boolean
Private Sub IVBSAXContentHandler_characters(strChars As String)
If (bGetChars) Then
sNodeValues = sNodeValues & Replace(Trim$(strChars), vbLf, "")
End If
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)
Select Case strLocalName
Case "Col"
bGetChars = False
Case "Row"
lCounter = lCounter + 1
Debug.Print lCounter & " " & sNodeValues
Case Else
' do nothing
End Select
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()
lCounter = 0
bGetChars = False
End Sub
Private Sub IVBSAXContentHandler_startElement(strNamespaceURI As String, strLocalName As String, strQName As String, ByVal oAttributes As MSXML2.IVBSAXAttributes)
Select Case strLocalName
Case "Row"
sNodeValues = ""
Case "Col"
sNodeValues = sNodeValues & "|" & oAttributes.getValueFromName(strNamespaceURI, "id") & ":"
bGetChars = True
Case Else
' do nothing
End Select
End Sub
Private Sub IVBSAXContentHandler_startPrefixMapping(strPrefix As String, strURI As String)
End Sub