Get headers of table when using XMLHTTP approach

Question

I have a code that grabs a table from this url

https://www.reuters.com/companies/AAPL.OQ/financials/income-statement-annual

The code is OK and no problem at all except one point. The code gets the table but doesn't get the header

    With http
    .Open "Get", sURL, False
    .send
    html.body.innerHTML = .responseText
End With

   Set tbl = html.getElementsByTagName("Table")(0)

        For Each rw In tbl.Rows
            r = r + 1: c = 1
            For Each cl In rw.Cells
                ws.Cells(r, c).Value = cl.innerText
                c = c + 1
            Next cl
    Next rw

When inspecting the URL, I found that API URL supported

https://www.reuters.com/companies/api/getFetchCompanyFinancials/AAPL.OQ

How can I extract the desired data "annual" for "income" from the JSON response?

I tried to refer to the section I desire but got an error

Const strUrl As String = "https://www.reuters.com/companies/api/getFetchCompanyFinancials/AAPL.OQ"

Sub Test()
Dim a, json As Object, colData As Collection, sFile As String, i As Long

With CreateObject("MSXML2.ServerXMLHTTP.6.0")
    .Open "GET", strUrl
    .send
    Set json = JSONConverter.ParseJson(.responseText)
End With


Set colData = json("market_data")("financial_statements")

Stop
End Sub

what was the error? There are numerous income lines- which do you require? — QHarr
– QHarr, Commented Apr 30, 2020 at 14:39
It is nested dicts with path json►market_data►financial_statements►income►annual — QHarr
– QHarr, Commented Apr 30, 2020 at 14:45
what error are you getting? Your code above looks fine with the exception of whether you need user-agent and if refreshed since headers and you are missing FALSE argument from .Open — QHarr
– QHarr, Commented Apr 30, 2020 at 15:20
This is also done in my head I'm afraid pastebin.com/JSVDViNu — QHarr
– QHarr, Commented Apr 30, 2020 at 18:25

QHarr · Accepted Answer · 2020-05-01 05:03:14Z

2

logic similar to this should work in vba:

Dim data As Scripting.Dictionary, key As Variant, block As Collection, r As Long, item As Object

Set data = json("market_data")("financial_statements")("financial_statements")("income")("annual") ' dict of collections

r = 1

For Each key In data.keys
    Set block = data(key)  'each block (section of info) is a row
    r = r + 1: c= 2
    For each item In block 'loop columns in block         
        With Activesheet
            If r = 2 then 'write out headers to row 1,starting col2 and then values to row 2 starting from col 2, and key goes in row , col 1
                .Cells(1,c) = item("date")
            End If
            .Cells(r,1) = Key
            .Cells(r,c) = item("value")
        End With
        c = c + 1
    Next
Next

I can't test in VBA but if I write the python (long hand) equivalent I get the same table:

import requests
import pandas as pd

json = requests.get('https://www.reuters.com/companies/api/getFetchCompanyFinancials/AAPL.OQ').json()
data = json["market_data"]["financial_statements"]["income"]["annual"]
rows = len(data.keys()) + 1
columns = len(data["Revenue"]) + 1
r = 0
df = pd.DataFrame(["" for c in range(columns)] for r in range(rows))

for key in data.keys():
    block = data[key]
    r+=1 ; c = 1
    for item in block:
        if r == 1:
            df.iloc[0 , c] = item["date"]
        df.iloc[r,c] = item["value"]
        df.iloc[r,0] = key
        c+=1
print(df)

edited May 1, 2020 at 5:03

answered Apr 30, 2020 at 19:29

QHarr

84.5k14 gold badges58 silver badges105 bronze badges

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

9 Comments

YasserKhalil Over a year ago

Thanks a lot my tutor. Note the item "Total Extraordinary Items" the value -5151 is in 28-09-2019 while in the JSON response it is 2018-09-29. It is supposed each value to the related date. May be there are more than 6 dates.

QHarr Over a year ago

Is it? In python it is in the right place. Can you screenshot the output from vba?

QHarr Over a year ago

That is correct. That is how it appears on the webpage

QHarr Over a year ago

where have you put your solution? Also, working code is a likely candidate for code review site. As for the mismatch that is not something I can answer. Perhaps json response shows reference date and this default to first column? Perhaps someone messed up with website. I really don't know and don't understand Corporate Finance beyond reading a book on it ~20 years ago.

QHarr Over a year ago

You should post it as an answer not edit it into your post. Also, remove the image. It keeps the post tidy and makes it easier for people to follow.

|

YasserKhalil · Accepted Answer · 2020-04-30 22:52:18Z

2

After so many hours, I could adjust it like that

Const strUrl As String = "https://www.reuters.com/companies/api/getFetchCompanyFinancials/"

Sub GetData()
    Dim ws As Worksheet, sSection As String

    For Each ws In ThisWorkbook.Worksheets(Array("IS", "BS", "CF"))
        Select Case ws.Name
            Case "IS": sSection = "income"
            Case "BS": sSection = "balance_sheet"
            Case "CF": sSection = "cash_flow"
        End Select

        GetReuters ws, "tbl" & ws.Name, Sheets("Data").Range("B1").Value, sSection, Sheets("Data").Range("B2").Value
    Next ws
End Sub

Sub GetReuters(ByVal ws As Worksheet, ByVal tblName As String, ByVal sTicker As String, ByVal sSection As String, ByVal sTime As String)
    Dim a, ky, col As Collection, json As Object, data As Object, dic As Object, rng As Range, i As Long, k As Long, c As Long

    With CreateObject("MSXML2.ServerXMLHTTP.6.0")
        .Open "GET", strUrl & sTicker
        .send
        Set json = JSONConverter.ParseJson(.responseText)
    End With

    ReDim b(1 To 10000, 1 To 7)
    c = 1: b(1, c) = "Dates"

    Set data = json("market_data")("financial_statements")(sSection)(sTime)
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1

    For Each ky In data.Keys
        Set col = data(ky)
        a = CollectionToArray(col)
        k = k + 1
        b(k + 1, 1) = ky

        For i = LBound(a) To UBound(a)
            If Not dic.Exists(CStr(a(i, 1))) Then
                dic(CStr(a(i, 1))) = c
                c = c + 1

                b(1, c) = CStr(a(i, 1))
                b(k + 1, c) = a(i, 2)

            Else
                b(k + 1, dic.item(CStr(a(i, 1))) + 1) = a(i, 2)
            End If
        Next i

        Erase a
    Next ky

    Application.ScreenUpdating = False
        With ws
            On Error Resume Next
                .ListObjects(tblName).Delete
            On Error GoTo 0
            .Range("A1").Resize(k + 1, UBound(b, 2)).Value = b
            With .Range("A1").CurrentRegion
                Set rng = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
                rng.NumberFormat = "#,##0.00;(#,##0.00)"
                rng.Rows(1).Offset(-1).NumberFormat = "dd-mmm-yy"
                .Columns.AutoFit
            End With

            .ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion, , xlYes).Name = tblName
        End With
    Application.ScreenUpdating = True
End Sub

Function CollectionToArray(ByVal c As Collection) As Variant()
    Dim a(), i As Long
    ReDim a(1 To c.Count, 1 To 2)

    For i = 1 To c.Count
        a(i, 1) = c.item(i)("date")
        a(i, 2) = c.item(i)("value")
    Next i

    CollectionToArray = a
End Function

edited Apr 30, 2020 at 22:52

answered Apr 30, 2020 at 21:05

YasserKhalil

9,60813 gold badges62 silver badges135 bronze badges

14 Comments

YasserKhalil Over a year ago

Yes in my PC it is perfect but when copying and pasting here I am suffering of that point. I don't know till now how to post the code as it is on my one side. The only perfect one is to post as HTML code

QHarr Over a year ago

I copied your pastebin code in, and with all code highlighted, pressed Ctrl + K to indent the code block the required 4 spaces for code inserts.

QHarr Over a year ago

Pleasure. This is a really useful post by the way: stackoverflow.com/a/41813615/6241235 for ByRef/ByVal and this,stackoverflow.com/help/formatting, for formatting.

YasserKhalil Over a year ago

Do you mean like that

Sub GetReuters(ByVal ws As Worksheet, ByVal tblName As String, ByVal sTicker As String, ByVal sSection As String, ByVal sTime As String)

?

YasserKhalil Over a year ago

I have updated the code .. according to your instructions. I appreciate that a lot.

|

Collectives™ on Stack Overflow

Get headers of table when using XMLHTTP approach

2 Answers 2

9 Comments

14 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

9 Comments

14 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related