VBA xmlhttp GET - getting data from table with irregular structure

Question

I try to get data from website through xmlhttp GET. Unfortunately table doesn't have a constant amount of columns in a row or rows in a column, because some cells are merged (I even had to change max amount of columns manually to 11 in the macro as 1st row has fewer columns).

I would like the output to go exactly as on the website.

Option Explicit

Public Sub GetTable()

Dim oDom As Object: Set oDom = CreateObject("htmlFile")
Dim x As Long, y As Long
Dim oRow As Object, oCell As Object
Dim vData As Variant
Dim link As String

link = "http://medicarestatistics.humanservices.gov.au/statistics/do.jsp?_PROGRAM=%2Fstatistics%2Fmbs_group_standard_report&DRILL=on&GROUP=Broad+Type+of+Service+%28BTOS%29&VAR=services&STAT=count&RPT_FMT=by+time+period+and+state&PTYPE=month&START_DT=201609&END_DT=201609"

y = 1: x = 1

With CreateObject("msxml2.xmlhttp")
    .Open "GET", link, False
    .Send
    oDom.body.innerHtml = .responseText
End With

With oDom.getelementsbytagname("table")(0)
    ReDim vData(1 To .Rows.Length, 1 To 11) '.Rows(1).Cells.Length)
    For Each oRow In .Rows
        For Each oCell In oRow.Cells
            vData(x, y) = oCell.innerText
            y = y + 1
        Next oCell
        y = 1
        x = x + 1
    Next oRow
End With

Sheets(1).Cells(1, 1).Resize(UBound(vData), UBound(vData, 2)).Value = vData
End Sub

You'll need to check the colSpan attribute of each TD/TH element, and create a merged cell for any colSpan > 1 — ThunderFrame
– ThunderFrame, Commented Oct 28, 2016 at 22:57

Comintern · Accepted Answer · 2016-10-29 02:21:43Z

1

Just check the row length each time through your loop and resize the array if you need more columns:

With oDom.getelementsbytagname("table")(0)
    Dim rowCount As Long
    rowCount = .Rows.Length
    ReDim vData(1 To rowCount, 1 To .Rows(0).Cells.Length)
    For Each oRow In .Rows
        Dim columnCount As Long
        columnCount = .Rows(x - 1).Cells.Length
        If columnCount > UBound(vData, 2) Then
            ReDim Preserve vData(1 To rowCount, 1 To columnCount)
        End If
        For Each oCell In oRow.Cells
            vData(x, y) = oCell.innerText
            y = y + 1
        Next oCell
        y = 1
        x = x + 1
    Next oRow
End With

EDIT:

Didn't check the column spans in the source table. One option would be to use @Thunderframe's suggestion and test for all of the column spans, but that seems a bit tedious. I'd personally leverage the fact that Excel knows how to paste HTML from the clipboard, and just let Excel figure it out:

With oDom.getelementsbytagname("table")(0)
    Dim dataObj As Object
    Set dataObj = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    dataObj.SetText "<table>" & .innerHtml & "</table>"
    dataObj.PutInClipboard
End With

Sheets(1).Paste Sheets(1).Cells(1, 1)

edited Oct 29, 2016 at 2:21

answered Oct 28, 2016 at 22:57

Comintern

22.3k6 gold badges36 silver badges83 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

Ryszard Jędraszyk Over a year ago

It handles array size properly, but unfortunately doesn't resolve the problem with merged cells causing wrong data output.

Comintern Over a year ago

@RyszardJędraszyk - Missed the column spans. See the edit.

Collectives™ on Stack Overflow

VBA xmlhttp GET - getting data from table with irregular structure

1 Answer 1

2 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related