VBA Code to read from a simple XML file to create a collection of objects in Word VBA Project

I have a very simple XML file. In a VBA Project for Word, I would like to read from this XML file named VerySimple and create a collection of Book Objects based on a Book class in my project.
I would appreciate help with VBA code that would help me achieve that.
The xmle file looks like this:
<?xml version="1.0"?>
<catalog>
   <book id="1">
      <author>Gambardella, Matthew</author>
      <title>XML Developer's Guide</title>
   </book>
   <book id="2">
      <author>Ralls, Kim</author>
      <title>Midnight Rain</title>
   </book>  
</catalog>

Open in new window

LVL 1
FaheemAhmadGulAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

ste5anSenior DeveloperCommented:
Using early binding with a reference to Microsoft XML:

Option Explicit

Private m_XDocument As MSXML2.DOMDocument60

Public Sub Test()

  LoadFromText "C:\Temp\Books.xml"
  ExtractBooks
  Set m_XDocument = Nothing

End Sub

Private Function ExtractBook(ABook As MSXML2.IXMLDOMNode) As Boolean
  
  Const ATTRIBUTE_ID As String = "id"
  Const XPATH_AUTHOR As String = "author"
  Const XPATH_TITLE As String = "title"

  On Local Error GoTo LocalError

  Dim Book As MSXML2.IXMLDOMNode

  Dim Author As String
  Dim ID As String
  Dim Title As String
  
  ExtractBook = True
  Author = XElement(XNode(ABook, XPATH_AUTHOR))
  ID = XAttribute(ABook, ATTRIBUTE_ID)
  Title = XElement(XNode(ABook, XPATH_TITLE))
  Debug.Print ID; Author; Title
  Exit Function

LocalError:
  ExtractBook = False
  Debug.Print Err.Description
  
End Function

Private Function ExtractBooks() As Boolean
  
  Const XPATH_BOOKS As String = "/catalog/book"

  On Local Error GoTo LocalError

  Dim Book As MSXML2.IXMLDOMNode

  ExtractBooks = True
  For Each Book In XDocumentNodes(XPATH_BOOKS)
    ExtractBook Book
  Next Book

  Exit Function

LocalError:
  ExtractBooks = False
  
End Function

Private Sub InitializeLoading()

  On Local Error Resume Next

  Set m_XDocument = Nothing
  Set m_XDocument = New MSXML2.DOMDocument60
  m_XDocument.async = False
  m_XDocument.validateOnParse = True

End Sub

Private Sub LoadFromText(AFileName As String)
  
  If Len(Dir(AFileName)) > 0 Then
    InitializeLoading
    m_XDocument.Load AFileName
  End If

End Sub

Private Function XAttribute(ANode As MSXML2.IXMLDOMNode, AAttributeName As String) As String

  On Local Error Resume Next
    
  XAttribute = ANode.Attributes.getNamedItem(AAttributeName).Text

End Function

Private Function XDocumentNode(AXPath As String) As MSXML2.IXMLDOMNode

  On Local Error Resume Next

  Set XDocumentNode = m_XDocument.SelectSingleNode(AXPath)

End Function

Private Function XDocumentNodes(AXPath As String) As MSXML2.IXMLDOMNodeList

  On Local Error Resume Next

  Set XDocumentNodes = m_XDocument.SelectNodes(AXPath)

End Function

Private Function XElement(ANode As MSXML2.IXMLDOMNode) As String

  On Local Error Resume Next
  
  XElement = ANode.Text

End Function

Private Function XNode(ANode As MSXML2.IXMLDOMNode, AXPath As String) As MSXML2.IXMLDOMNode

  On Local Error Resume Next

  Set XNode = ANode.SelectSingleNode(AXPath)

End Function

Private Function XNodes(ANode As MSXML2.IXMLDOMNode, AXPath As String) As MSXML2.IXMLDOMNodeList

  On Local Error Resume Next

  Set XNodes = ANode.SelectNodes(AXPath)

End Function

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
FaheemAhmadGulAuthor Commented:
Wonderful!!
Worked perfectly. Many thanks.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.