VBA XML

XML, or eXtensible Markup Language, is used to structure, serialize, and transmit data between applications. The MSXML2 library is used to work with XML in VBA. Functions in the MSXML2 library often use the XPath language to navigate an XML document.

Validate And Load XML

XSD, or XML Schema Definition, files are used to define the structure and rules of an XML document. The MSXML2 library can be used to validate XML files against XSD schemas. When creating an XSD document, be sure to use a validation tool to validate the XML with the XSD and make sure the XML and XSD are both well-formed before relying on VBA code for validation. XML files can be loaded from the user's local machine or from a website.

Option Explicit

'modXML - Requires a reference to "Microsoft XML, v6.0

Public Function ValidateXML(XMLPath$, XSDPath$, XSDNamespace$) As Boolean

    Dim XMLDoc As MSXML2.DOMDocument60
    Dim XSDDoc As MSXML2.DOMDocument60
    Dim SCache As MSXML2.XMLSchemaCache60
    Dim XMLErr As MSXML2.IXMLDOMParseError

    Set XMLDoc = New MSXML2.DOMDocument60
    XMLDoc.async = False
    XMLDoc.Load XMLPath

    Set XSDDoc = New MSXML2.DOMDocument60
    XSDDoc.async = False
    XSDDoc.resolveExternals = True
    XSDDoc.Load XSDPath

    Set SCache = New MSXML2.XMLSchemaCache60
    SCache.Add XSDNamespace, XSDDoc

    Set XMLDoc.Schemas = SCache

    Set XMLErr = XMLDoc.Validate()

    ValidateXML = (XMLErr.ErrorCode = 0)

    If Not ValidateXML Then
        PrintXMLParseErrorInfo XMLErr
    End If

End Function

Public Function LoadXML(XMLPath$, XSDPath$, XSDNamespace$) As MSXML2.DOMDocument60

    Dim XMLDoc As MSXML2.DOMDocument60
    Dim XSDDoc As MSXML2.DOMDocument60
    Dim SCache As MSXML2.XMLSchemaCache60
    Dim XMLErr As MSXML2.IXMLDOMParseError

    Set XSDDoc = New MSXML2.DOMDocument60
    XSDDoc.async = False
    XSDDoc.resolveExternals = True
    XSDDoc.Load XSDPath

    Set SCache = New MSXML2.XMLSchemaCache60
    SCache.Add XSDNamespace, XSDDoc

    Set XMLDoc = New MSXML2.DOMDocument60
    XMLDoc.async = False
    XMLDoc.resolveExternals = True
    XMLDoc.validateOnParse = True
    Set XMLDoc.Schemas = SCache
    If XMLDoc.Load(XMLPath) Then
        Debug.Print "XML Loaded"
    Else
        Debug.Print "XML Not Loaded"
    End If

    If XMLDoc.parseError.ErrorCode <> 0 Then
        Debug.Print XMLDoc.parseError.ErrorCode
        Debug.Print XMLDoc.parseError.reason
        Err.Raise _
        Number:=1004, _
        Description:=XMLDoc.parseError.ErrorCode & vbCrLf & _
        XMLDoc.parseError.reason
    End If

    Set LoadXML = XMLDoc

End Function

Public Sub PrintXMLParseErrorInfo(XMLErr As MSXML2.IXMLDOMParseError)

    With XMLErr
        Debug.Print "ErrorCode: " & .ErrorCode
        Debug.Print "reason: " & .reason
        Debug.Print "URL: " & .URL
        Debug.Print "srcText: " & .srcText
        Debug.Print "filepos: " & .filepos
        Debug.Print "linepos: " & .linepos
        Debug.Print "Line: " & .Line
    End With

End Sub

Local XML File

To validate and load a local XML file, supply a file path to the load method for the MSXML2.DOMDocument objects associated with the XSD and XML documents.

Option Explicit

Public Sub Example()

    Dim XMLPath$
    XMLPath = "C:\test.xml"

    Dim XSDPath$
    XSDPath = "C:\test.xsd"

    Dim XSDNamespace$
    XSDNamespace = "https://www.example.org/"

    If Not ValidateXML(XMLPath, XSDPath, XSDNamespace) Then
        MsgBox "Validation Failed.", vbCritical
        Exit Sub
    End If

    Dim XMLDoc As MSXML2.DOMDocument60
    Set XMLDoc = LoadXML(XMLPath, XSDPath, XSDNamespace)

    Dim Egs As MSXML2.IXMLDOMNodeList
    Set Egs = XMLDoc.DocumentElement.SelectNodes(".//example")

    Dim Eg As MSXML2.IXMLDOMNode
    For Each Eg In Egs
        Debug.Print Eg.FirstChild.Text
    Next Eg

End Sub

"C:\test.xsd"

<?xml version="1.0" encoding="UTF-8"?>
<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema" 
targetNamespace="https://www.example.org/" 
xmlns:eg="https://www.example.org/">
    <xs:element name="examples">
        <xs:complexType>
            <xs:sequence>
                <xs:element name="example" maxOccurs="unbounded" minOccurs="0">
                    <xs:complexType>
                        <xs:sequence>
                            <xs:element name="string" type="xs:string"/>
                            <xs:element name="integer" type="xs:integer"/>
                            <xs:element name="decimal" type="xs:decimal"/>
                        </xs:sequence>
                        <xs:attribute name="exampleindex" type="xs:integer" use="required"/>
                    </xs:complexType>
                </xs:element>
            </xs:sequence>
        </xs:complexType>
    </xs:element>
</xs:schema>

"C:\test.xml"

<?xml version="1.0" encoding="UTF-8"?>
<eg:examples xmlns:eg="https://www.example.org/">
    <example exampleindex="1">
        <string>"Hello, World!"</string>
        <integer>100</integer>
        <decimal>3.5</decimal>
    </example>
</eg:examples>

XML from Website

To get XML data from a website supply a Web URL to the Load method of a MSXML2.DOMDocument object. The XSD for the XML data may be available on the website at another URL or may be available for download. The example below uses the U.S. Department of the Treasury's website to get the Daily Treasury Yield Curve Rates. The XSD files are available for download on the site. Be sure to download the XSD files for the correct filters given the drop-down settings on the site.

Option Explicit

Public Sub Example()

    Dim XMLPath$
    XMLPath = "https://data.treasury.gov/feed.svc/DailyTreasuryYieldCurveRateData" & _
            "?$filter=year(NEW_DATE)%20eq%202021"
    
    Dim XSDPath$
    'Download XSD files from website for correct filter
    XSDPath = "C:\Daily Treasury Yield Curve\DailyTreasuryYieldCurveRateData.xsd"
    
    Dim XSDNamespace$
    XSDNamespace = "http://www.w3.org/2005/Atom"

    If Not ValidateXML(XMLPath, XSDPath, XSDNamespace) Then
        MsgBox "Validation Failed.", vbCritical
        Exit Sub
    End If
    
    Dim XMLDoc As MSXML2.DOMDocument60
    Set XMLDoc = LoadXML(XMLPath, XSDPath, XSDNamespace)
    XMLDoc.SetProperty "SelectionNamespaces", "xmlns:dummy=""http://www.w3.org/2005/Atom"""
    
    Dim Entries As MSXML2.IXMLDOMNodeList
    Set Entries = XMLDoc.DocumentElement.SelectNodes(".//dummy:entry")
    
    Dim Entry As MSXML2.IXMLDOMNode
    For Each Entry In Entries
        Debug.Print Entry.LastChild.Text
    Next Entry
    
End Sub

v3.0 Versus v6.0

MSXML2.DOMDocument60 may require that the xml namespace be used for the SelectNodes method. When tags are in the default namespace they may not have an identifier and a dummy namespace identifier will need to be provided.

Public Sub GetDailyTreasuryYieldCurveRateData()

    Dim XMLDoc   As Object 'MSXML2.DOMDocument30
    Dim Entries  As Object 'MSXML2.IXMLDOMNodeList
    Dim Entry    As Object 'MSXML2.IXMLDOMNode
    Dim DataNode As Object 'MSXML2.IXMLDOMNode
    Dim URL      As String

    Set XMLDoc = CreateObject("MSXML2.DOMDocument.3.0")
    XMLDoc.async = False

    URL = _
    "https://data.treasury.gov/feed.svc/DailyTreasuryYieldCurveRateData" & _
    "?$filter=year(NEW_DATE)%20eq%202020"

    If Not XMLDoc.Load(URL) Then
        MsgBox "XML not loaded.", vbOKOnly + vbCritical
        Exit Sub
    End If

    Set Entries = XMLDoc.DocumentElement.SelectNodes(".//entry")
   'Set Entries = XMLDoc.getElementsByTagName("entry") 'Same as above

    For Each Entry In Entries
        Debug.Print Entry.LastChild.Text
    Next Entry

    Set Entries = Nothing
    Set XMLDoc = Nothing

End Sub

Public Sub GetDailyTreasuryYieldCurveRateData()

    Dim XMLDoc   As Object 'MSXML2.DOMDocument60
    Dim Entries  As Object 'MSXML2.IXMLDOMNodeList
    Dim Entry    As Object 'MSXML2.IXMLDOMNode
    Dim DataNode As Object 'MSXML2.IXMLDOMNode
    Dim URL      As String

    Set XMLDoc = CreateObject("MSXML2.DOMDocument.6.0")
    XMLDoc.async = False

    URL = _
    "https://data.treasury.gov/feed.svc/DailyTreasuryYieldCurveRateData" & _
    "?$filter=year(NEW_DATE)%20eq%202020"

    If Not XMLDoc.Load(URL) Then
        MsgBox "XML Not Loaded"
        Exit Sub
    End If

    XMLDoc.SetProperty "SelectionNamespaces", "xmlns:dummy=""http://www.w3.org/2005/Atom"""
    Set Entries = XMLDoc.DocumentElement.SelectNodes(".//dummy:entry")
    'Set Entries = XMLDoc.DocumentElement.SelectNodes(".//entry") 'DOES NOT WORK

    For Each Entry In Entries
        Debug.Print Entry.LastChild.Text
    Next Entry

    Set Entries = Nothing
    Set XMLDoc = Nothing

End Sub