Reading XML into Excel

One interesting use for Excel is using it as a platform for calling web services. While the Web Browser is the obvious platform for sending and receiving web based data, sometimes Excel is a better application to analyse formatted lists or numerical data. Excel gives you the ability to import and query data via web services.


Excel VBA - Loading XML string defined in program into VBA XML DOM Document

In this example we define an XML string, load the string and use it to populate a DOM document.

Sub XMLTest01()
    'In Tools > References, add reference to "Microsoft XML, vX.X" before running.
	
    'create instance of the DOMDocument object:
    Dim xmlDoc As MSXML2.DOMDocument
    Set xmlDoc = New MSXML2.DOMDocument
    
    Dim strXML As String
    
    'create XML string
    strXML = "<fullName>" & _
                "<firstName>Bob</firstName>" & _
                "<lastName>Smith</lastName>" & _
            "</XXXfullName>"
    
    ' use XML string to create a DOM, on error show error message 
    If Not xmlDoc.LoadXML(strXML) Then
        Err.Raise xmlDoc.parseError.ErrorCode, , xmlDoc.parseError.reason
    End If
	
End Sub	

XML error message: Note that there is an error in the terminating the XML fullname tag



Some VBA vocabulary

MSXML2.DOMDocument The DOMDocument object represents the top node in the tree. It implements all of the base Document Object Model (DOM) document methods and provides additional members that support Extensible Stylesheet Language (XSL) and XML transformations. Only one object can be created: the document. All other objects are accessed or created from the document.

LoadXML Loads an XML document using the supplied string.



Loading XML in Excel VBA - Enhanced error reporting

Sub XMLTest02()
    'In Tools > References, add reference to "Microsoft XML, vX.X" before running.
    
    'create instance of the DOMDocument class:
    Dim xmlDoc As MSXML2.DOMDocument
    Set xmlDoc = New MSXML2.DOMDocument
    
    Dim strErrText As String
    Dim xmlError As MSXML2.IXMLDOMParseError
        
    Dim strXML As String
    
    'create XML string
    strXML = "<fullName>" & _
                "<firstName>Bob</firstName>" & _
                "<lastName>Smith</lastName>" & _
             "</XXXfullName>"
    
    ' use XML string to create a DOM, on error show error message
    If Not xmlDoc.LoadXML(strXML) Then
        
        ' get the ParseError object
        Set xmlError = xmlDoc.parseError
        With xmlError
        strErrText = "Your XML Document failed to load" & _
          "due the following error." & vbCrLf & _
          "Error #: " & .ErrorCode & ": " & xmlError.reason & _
          "Line #: " & .Line & vbCrLf & _
          "Line Position: " & .linepos & vbCrLf & _
          "Position In File: " & .filepos & vbCrLf & _
          "Source Text: " & .srcText & vbCrLf
        End With
        
        ' Display error & exit program
        MsgBox strErrText, vbExclamation
        Set xmlDoc = Nothing
        End
        
    End If
    
End Sub



XML error message: Note that there is an error in the terminating the XML fullname tag



Reading an XML file into Excel

'In Tools > References, add reference to "Microsoft XML, vX.X" before running.
Sub subReadXMLStream()
    
    Dim xmlDoc As MSXML2.DOMDocument
    Dim xEmpDetails As MSXML2.IXMLDOMNode
    Dim xParent As MSXML2.IXMLDOMNode
    Dim xChild As MSXML2.IXMLDOMNode
    Dim Col, Row As Integer

    Set xmlDoc = New MSXML2.DOMDocument
    xmlDoc.async = False
    xmlDoc.validateOnParse = False
    ' use XML string to create a DOM, on error show error message
    If Not xmlDoc.Load("http://itpscan.info/blog/excel/xml/schedule.xml") Then
        Err.Raise xmlDoc.parseError.ErrorCode, , xmlDoc.parseError.reason
    End If
        
    Set xEmpDetails = xmlDoc.DocumentElement
    Set xParent = xEmpDetails.FirstChild
    
    Row = 1
    Col = 1
    
    Dim xmlNodeList As IXMLDOMNodeList
    
    Set xmlNodeList = xmlDoc.SelectNodes("//record")
    
    For Each xParent In xmlNodeList
        For Each xChild In xParent.ChildNodes
            Worksheets("Sheet1").Cells(Row, Col).Value = xChild.Text
            Debug.Print Row & " - "; Col & " -  " & xChild.Text
            Col = Col + 1
        Next xChild
        Row = Row + 1
        Col = 1
    Next xParent
End Sub

Some VBA vocabulary

MSXML2.IXMLDOMNode The IXMLDOMNode object provides methods that represent the core functionality of any node.

async XML DOM property that specifies whether asynchronous download is permitted.

validateOnParse XML DOM property that indicates whether the parser should validate this document.

FirstChild Gets the first child of the node.


output in MS Excel:



Clear cache

This code is useful if you are using Apache Basic Athorization and user changes their userid/password. Even if the code creates a brand new XMLHttpReq object and sets this header to the new information, it logs in to the server as the first user, presumably from cached credentials. This code eventively clears the cache in most browsers and lets user log in with a new username/password combination.

Sub subClearCache()
    
    ' force browser to clear cache
    myURL = "http://172.16.50.250/blackberry/BBTESTB01.pgm"
    Dim oHttp As New MSXML2.XMLHTTP
    oHttp.Open "POST", myURL, False
    oHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    oHttp.setRequestHeader "Cache-Control", "no-cache"
    oHttp.setRequestHeader "PragmaoHttp", "no-cache"
    oHttp.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
    oHttp.setRequestHeader "Authorization", "Basic " & Base64EncodedUsernamePassword
    oHttp.send "PostArg1=PostArg1Value"
    Result = oHttp.responseText
    
End Sub