Convert HTML Table Into An Array Formula Result - Public Content

Powerful mechanism to get any data you like into Excel (SOA etc)

1. Get some XML which represents your data item
2. Write some XSL that turns your data item xml into a simple html table
3. Import that into an excel array, thus returning the value from your array formula

Get the item as an html table

Function getItemAsHTMLTable(fullurl As String) As String
    Dim result As ServerXMLHTTP
  
    Set result = sendRequest(fullurl, "GET")
    
    If (result Is Nothing) Then
        Exit Function
    ElseIf (result.Status <> 200) Then
        Exit Function
    End If
        
    Dim document As New MSXML2.DOMDocument
    
    document.loadXML (result.responseText)
    
    If (document.parseError.errorCode <> 0) Then
        Err.Raise errorBaseValue + 10, "XMLLoader.getItemAsHTMLTable", "XML Document Invalid" & document.parseError.reason
    End If
        
    Dim xslprocessor As MSXML2.IXSLProcessor
    
    Set xslprocessor = getXslProcessor("C:\somefile.xsl")
    
    xslprocessor.input = document
    
    xslprocessor.transform
    
    getItemAsHTMLTable= xslprocessor.output

End Function

Convert it to an array - taking care of the data types

Sub tableToArray(document As MSXML2.DOMDocument, ary As Variant)
    
    Dim wantedRows As Integer
    Dim wantedColumns As Integer
    
    wantedRows = UBound(ary, 1)
    wantedColumns = UBound(ary, 2)
    
    Dim tableRowCount As Integer
    
    tableRowCount = document.selectNodes("//table/tr").Length
        
    Dim errorCondition As Boolean
    Dim errorMessage As String
    
    errorCondition = False
    
    If (tableRowCount > wantedRows) Then
        errorCondition = True
        errorMessage = "Range too small: Need " & tableRowCount & " rows, have only " & wantedRows
    End If
        
    Dim row As Integer
    
    For row = 0 To wantedRows
        Dim tableColumnCount As Integer
        Dim query As String
        
        If (row > tableRowCount) Then
            tableColumnCount = 0
        Else
            query = "//table/tr[" & row & "]/td"
            tableColumnCount = document.selectNodes(query).Length
        End If
            
        If (tableColumnCount > wantedColumns) Then
            errorCondition = True
            errorMessage = "Range too small at row " & row & " need " & tableColumnCount & " cols, have " & wantedColumns
        End If
            
        Dim col As Integer
        For col = 0 To wantedColumns
            
            If (row >= tableRowCount) Then
                ary(row, col) = ""
            ElseIf (col >= tableColumnCount) Then
                ary(row, col) = ""
            ElseIf (errorCondition) Then
                ary(row, col) = errorMessage
            Else
                query = "//table/tr[" & row & "]/td[" & col & "]"
                ary(row, col) = convertToNiceType(document.selectSingleNode(query).text)
            End If
            
        Next col
    Next row
End Sub

Function convertToNiceType(text As String) As Variant
    On Error GoTo tryDate
    convertToNiceType = CDbl(text)
    Exit Function
tryDate:
    If (IsDate(text)) Then
        convertToNiceType = CDate(text)
    Else
        convertToNiceType = text
    End If
End Function

Now write your top level function

Function getWebServiceDataItem(url As String, wanteddate As String, item As String) As Variant

    On Error GoTo someerror
    
    Dim fullurl As String
    
    fullurl = url & "/" & wanteddate & "/" & item
    
    Dim outputDocument As New MSXML2.DOMDocument

    outputDocument.loadXML (getItemAsHTMLTable(fullurl))
    
    Dim wantedRows As Integer
    Dim wantedCols As Integer
    
    wantedRows = Application.Caller.rows.Count
    wantedCols = Application.Caller.Columns.Count
    
    Dim ary()
    
    ReDim ary(wantedRows, wantedCols)
    
    tableToArray outputDocument, ary
        
    getWebServiceDataItem = ary
    
    Exit Function
someerror:
    getWebServiceDataItem = "Can't get data item: " & Err.Description
End Function