VBA 中的 SAX 解析器

如何解决VBA 中的 SAX 解析器

我正在使用 vba 宏来解析大型 xml 文件。最初，我使用了 DOM 解析器，但由于内存泄漏，系统挂起，无法解决我的问题。现在，我转向使用 SAX 处理程序，如下面的代码所示，但出现错误。请帮我检查一下，让我知道我错在哪里

类模块

名称：clsBook

Option Explicit

Private mID As Integer
Private mAuthour As String
Private mTitle As String
Private mGenre As String
Private mPrice As String
Private mpublishDate As String
Private mDescription As String

Public Static Property Get ID() As Integer
ID = mID
End Property

Public Static Property Let ID(ByVal vNewValue As Integer)
mID = vNewValue
End Property



Public Static Property Get Authour() As String
Authour = mAuthour
End Property

Public Static Property Let Authour(ByVal vNewValue As String)
mAuthour = vNewValue
End Property



Public Property Get Title() As String
Title = mTitle
End Property

Public Property Let Title(ByVal vNewValue As String)
mTitle = vNewValue
End Property


Public Property Get Genre() As String
Genre = mGenre
End Property

Public Property Let Genre(ByVal vNewValue As String)
bGenre = mNewValue
End Property



Public Property Get Price() As String
Price = mPrice
End Property

Public Property Let Price(ByVal vNewValue As String)
mPrice = vNewValue
End Property




Public Property Get Description() As String
Description = mDescription
End Property

Public Property Let Description(ByVal vNewValue As String)
mDescription = vNewValue
End Property

Public Property Get PublishedDate() As String
PublishedDate = mpublishDate
End Property

Public Property Let PublishedDate(ByVal vNewValue As String)
mpublishDate = vNewValue
End Property

类模块：ContentHandlerImpl

Option Explicit

Implements IVBSAXContentHandler

Private lCounter As Long
Private sNodeValues As String
Private bAuthor As Boolean
Private bTitle As Boolean
Private bPrice As Boolean
Private bGenre As Boolean
Private bDescription As Boolean
Private bPublishDate As Boolean
Private mBook As clsBook
Private mBooks As Collection

Private Sub IVBSAXContentHandler_characters(strChars As String)

If (bAuthor) Then
mBook.Authour = strChars
bAuthor = False
ElseIf (bTitle) Then
mBook.Title = strChars
bTitle = False
ElseIf (bGenre) Then
mBook.Genre = strChars
bGenre = False
ElseIf (bPrice) Then
mBook.Price = strChars
bPrice = False
ElseIf (bPublishDate) Then
mBook.PublishedDate = strChars
bPublishDate = False
ElseIf (bDescription) Then
mBook.Description = strChars
bDescription = False
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 "book"
If mBooks Is nothing Then
Set mBooks = New Collection
End If
mBooks.Add (mBook)
If mBook Is Not nothing Then
Set mBook = nothing
End If
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()

End Sub

Private Sub IVBSAXContentHandler_startElement(strNamespaceURI As String,strQName As String,ByVal oAttributes As MSXML2.IVBSAXAttributes)

Select Case strLocalName
Case "book"
If mBook Is nothing Then
Set mBook = New clsBook
End If
mBook.ID = CInt(oAttributes.getValueFromName("","id"))
Case "author"
bAuthor = True
Case "title"
bTitle = True
Case "genre"
bGenre = True
Case "price"
bPrice = True
Case "publish_date"
bPublishDate = True
Case "description"
bDescription = True
Case Else
' do nothing
End Select

End Sub

Private Sub IVBSAXContentHandler_startPrefixMapping(strPrefix As String,strURI As String)

End Sub

Public Function getBooks() As Collection
getBooks = mBooks
End Function


Test Function


Sub main()

Dim saxReader As SAXXMLReader60
Dim saxhandler As ContentHandlerImpl
Dim iItems As Collection
Dim iItem As clsBook


Set saxReader = New SAXXMLReader60
Set saxhandler = New ContentHandlerImpl

Set saxReader.contentHandler = saxhandler
saxReader.Parse ThisWorkbook.Path & "\books.xml"



Set iItem = New clsBook
Set iItems = saxhandler.getBooks

For Each iItem In iItems
Debug.Print "ID: " & iItem.ID & vbCrLf & "Authour: " & iItem.Authour & vbCrLf & "Title: " & iItem.Title & vbCrLf
Next iItem

Set saxReader = nothing
End Sub




'############Ps find below the point where I am getting the error

Sub main()



Set saxReader = New SAXXMLReader60
Set saxhandler = New ContentHandlerImpl

Set saxReader.contentHandler = saxhandler
saxReader.Parse ThisWorkbook.Path & "\books.xml"


Set saxReader = nothing
End Sub

请有人告诉我我做错了什么或者我应该怎么做才能解决这个问题。

谢谢

解决方法

错误是系统错误：-2146828275，文件大小为 9GB。

谢谢