Consuming OData with Office VBA - Part II - Marcelo's WebLog - Site Home

In case the title didn't give the fact away, this is the second part of a series - the first part is here. This post builds on the code from that post, so make sure you've gone over that before continuing.

Last time, we simply got an XML document in the form of a DOMDocument object, and wrote out the XML to a Microsoft Word document.

This time, we'll take the XML document and put it into a format that makes it easier to use. We'll simplify things a lot and leave out some of the implementation that we're not concerned with now - I want something that is very easy to use. We'll just grab each entry or record and put it into a dictionary of name/value pairs, and we'll turn a feed into a collection of these dictionaries. This provides a nice representation for the data that we can then work with.

Without further ado, this is the function we'll call to turn our feed into a collection of objects.

' Given an OData feed document, reads the entries into a Collection.
Function ODataReadFeed(ByVal objFeed As MSXML2.IXMLDOMElement) As Collection
    Dim objResult As Collection
    Dim objChild As MSXML2.IXMLDOMNode

    Set objResult = New Collection

    Set objChild = objFeed.FirstChild
    While Not objChild Is Nothing
        If objChild.NodeType = NODE_ELEMENT And _
            objChild.NamespaceURI = AtomNamespace And _
            objChild.baseName = "entry" Then
            objResult.Add ODataReadEntry(objChild)
        End If
        Set objChild = objChild.NextSibling
    Wend

    Set ODataReadFeed = objResult
End Function

This function simply looks for 'entry' elements in the XML and then processes those.

' Given an OData entry element, reads the properties into a dictionary.
Private Function ODataReadEntry(ByVal objEntry As MSXML2.IXMLDOMElement) As Scripting.Dictionary
    Dim objResult As Scripting.Dictionary
    Dim objChild As MSXML2.IXMLDOMNode
    Dim baseName As String

    Set objResult = New Scripting.Dictionary

    Set objChild = objEntry.FirstChild
    While Not objChild Is Nothing
        If objChild.NodeType = NODE_ELEMENT And _
            objChild.NamespaceURI = AtomNamespace Then
            baseName = objChild.baseName
            If baseName = "id" Or baseName = "title" Or baseName = "updated" Then
                objResult.Add "odata_" & baseName, objChild.Text
            ElseIf baseName = "link" Then
                ' TODO: handle this element as necessary
            ElseIf baseName = "category" Then
                ' TODO: handle this element as necessary
            ElseIf baseName = "author" Then
                ' TODO: handle this element as necessary
            ElseIf baseName = "content" Then
                ODataReadContent objChild, objResult
            End If
        End If
        Set objChild = objChild.NextSibling
    Wend

    Set ODataReadEntry = objResult
End Function

As you can see, for each entry we create a dictionary. Right now we're mostly interested in the properties that come in the content of the entry, so again we'll mostly rely on another helper function.

' Given an OData 'content' element, reads the properties into the specified dictionary.
Private Sub ODataReadContent( _
        ByVal objContent As MSXML2.IXMLDOMElement, _
        ByVal objEntryDictionary As Scripting.Dictionary)
    Dim objChild As MSXML2.IXMLDOMElement
    Dim objProperties As MSXML2.IXMLDOMElement

    ' Look for the m:properties element.
    Set objProperties = Nothing
    Set objChild = objContent.FirstChild
    While Not objChild Is Nothing
        If objChild.NodeType = NODE_ELEMENT And _
            objChild.NamespaceURI = ODataMetadataNamespace And _
            objChild.baseName = "properties" Then
            Set objProperties = objChild
        End If
        Set objChild = objChild.NextSibling
    Wend

    ' Read all properties from the m:properties element.
    If Not objProperties Is Nothing Then
        Set objChild = objProperties.FirstChild
        While Not objChild Is Nothing
            ' TODO: handle null properties and complex types
            If objChild.NodeType = NODE_ELEMENT And _
                objChild.NamespaceURI = ODataNamespace Then
                objEntryDictionary.Add objChild.baseName, objChild.Text
            End If
            Set objChild = objChild.NextSibling
        Wend
    End If
End Sub

Throughout, we've been referencing some XML namespaces that help us distinguish regular ATOM elements from actual data or simple metadata. Let's declare those together with the other constants from the last post.

' Error codes from the first sample:
Const ODataErrorFirst As Long = 100
Const ODataCannotReadUrlError As Long = ODataErrorFirst + 1
Const ODataParseError As Long = ODataErrorFirst + 2

' XML namespaces:
Const AtomNamespace As String = "http://www.w3.org/2005/Atom"
Const ODataNamespace As String = "http://schemas.microsoft.com/ado/2007/08/dataservices"
Const ODataMetadataNamespace As String = "http://schemas.microsoft.com/ado/2007/08/dataservices/metadata"

Now all we need to do is put the old function ODataReadUrl together with our new ODataReadFeed function, and then we can go format the results or do whatever we want with them.

Public Sub Sample2()
    Dim objDocument As MSXML2.DOMDocument60
    Dim objEntries As Collection
    Dim strUrl As String

    ' Read the document with data.
    strUrl = "http://ogdi.cloudapp.net/v1/gsa/ConusPerDiemRates2009/"
    Set objDocument = ODataReadUrl(strUrl)

    ' Create a collection of dictionaries with name/value pairs.
    Set objEntries = ODataReadFeed(objDocument.DocumentElement)

    ' Prepare for updating and clear the document.
    Application.ScreenUpdating = False
    ActiveDocument.Content.Delete
    ActiveDocument.Content.Style = Styles("Normal")
    ActiveDocument.Content.ListFormat.RemoveNumbers

    ' Build a bulleted list for each state.
    Dim objEntry As Scripting.Dictionary
    Dim objRange As Range
    Dim strText As String
    Dim strLastState As String

    Set objRange = ActiveDocument.Range(0, 0)
    For Each objEntry In objEntries
        If objEntry("state") = "" Then
            ' Special message.
            objRange.Text = objEntry("primarydestination") & _
                " (" & objEntry("total") & ")"
            objRange.InsertParagraphAfter
        Else
            ' Write the state out only if different from the last.
            If strLastState <> objEntry("state") Then
                strLastState = objEntry("state")
                objRange.Text = objEntry("state")
                objRange.InsertParagraphAfter
                objRange.Style = Styles("Heading 2")
                objRange.SetRange objRange.End + 1, objRange.End + 1
            End If

            strText = objEntry("primarydestination") & ": " _
                & objEntry("total")

            If objEntry("seasonbegindate") <> "" Then
                strText = strText & " (between " & _
                    Left(objEntry("seasonbegindate"), 10) & _
                    " and " & Left(objEntry("seasonenddate"), 10) & ")"
            End If

            objRange.Text = strText
            objRange.InsertParagraphAfter
            objRange.ListFormat.ApplyBulletDefault
        End If

        objRange.SetRange objRange.End + 1, objRange.End + 1
    Next

    Application.ScreenUpdating = True
End Sub

As you'll notice, once we have our OData helper functions in place, the more interesting VBA code deals with how to manipulate and present the data. Getting data to improve your documents is the easiest step overall.

Enjoy!