Error 1004 when pulling table with ActiveWorkbook.Queries.Add - html

Question

I'm trying to create a quick way to pull financial statements (a basic table) from yahoo finance (e.g. https://finance.yahoo.com/quote/FB/financials?p=FB) with VBA.
I'm a complete noob so I used the record macro tool and Get data from web and tried (with my non-existent VBA knowledge) to adapt it to use a variable (Ticker) to change the company.
When using the get data from web function the table is imported perfectly but it doesn't work with VBA code. I get 1004 error about either ListObject.DisplayName or Refresh BackgroundQuery
Sub Macro5()
Dim Ticker As String
Ticker = InputBox("Ticker")
ActiveWorkbook.Queries.Add Name:="Table" & Ticker, Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.Page(Web.Contents(""https://finance.yahoo.com/quote/& Ticker &/financials?p=&Ticker &""))," & Chr(13) & "" & Chr(10) & " Data2 = Source{2}[Data]," & Chr(13) & "" & Chr(10) & " #""Type modifié"" = Table.TransformColumnTypes(Data2,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}, {""Column4"", type text}, {""Column5"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Type modifié"""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table & Ticker")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table" & Ticker
.Refresh BackgroundQuery:=False
End With
End Sub
The idea is to output the Income Statement form for the "Ticker" (FB in my exemple).
I'm using Excel 365 on windows
Thanks a lot

Answer 1

An easy method is to grab all the table elements on the page and loop those using clipboard to copy paste to sheet. You can adapt to write to different sheets based on ticker value. Use a loop over tickers to retrieve data but ensuring you create the ie object before the loop and then have the navigate2 within the loop so as to visit each new ticker page.
Public Sub GetTables()
Dim clipboard As Object, ws As Worksheet, j As Long, tables As Object
Dim ie As Object, ticker As String
ticker = "FB"
Set ws = ThisWorkbook.Worksheets("Sheet1")
ws.Cells.UnMerge
ws.Cells.ClearContents
Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Application.ScreenUpdating = False
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.Navigate2 "https://finance.yahoo.com/quote/FB/financials?p=" & ticker
While .Busy Or .readyState < 4: DoEvents: Wend
Set tables = .document.querySelectorAll("table")
For j = 0 To tables.Length - 1
clipboard.SetText tables.item(j).outerHTML
clipboard.PutInClipboard
ws.Cells(LastRow(ws) + 2, 1).PasteSpecial
Next
.Quit
End With
Application.ScreenUpdating = True
End Sub
'https://www.rondebruin.nl/win/s9/win005.htm
Public Function LastRow(ByVal sh As Worksheet) As Long
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
This second method is rather a leap in knowledge for you, but maybe useful in future and to other readers. You can extract all the info on the page from a script tag. With some string splitting on the innerHTML of that script element you can get a string which a json parser can handle. You can then parse the json for whatever info you want. I include an outline only below.
Option Explicit
'VBE > Tools > References:
' Microsoft Internet Controls
' Microsoft Scripting Runtime
'Download and add in jsonconverter.bas from https://github.com/VBA-tools/VBA-JSON/blob/master/JsonConverter.bas
Public Sub GetYahooData()
Dim IE As New InternetExplorer, ticker As String
ticker = "FB"
With IE
.Visible = True
.Navigate2 "https://finance.yahoo.com/quote/FB/financials?p=" & ticker
While .Busy Or .readyState < 4: DoEvents: Wend
Dim script As Object, scripts As Object, i As Long, extract As String, json As Object
Set scripts = .document.querySelectorAll("script")
For i = 0 To scripts.Length - 1
If InStr(1, scripts.item(i).innerHTML, "/* -- Data -- */") Then
Set script = scripts.item(i)
Exit For
End If
Next
If Not script Is Nothing Then
extract = Split(Split(script.innerHTML, "root.App.main = ")(1), "(this));")(0)
extract = Left$(extract, InStrRev(extract, ";") - 1)
Set json = JsonConverter.ParseJson(extract)("context")("dispatcher")("stores")("QuoteSummaryStore")("cashflowStatementHistory")
End If
If Not json Is Nothing Then
'parse json for data of interest
End If
Stop ' <== Delete me later
.Quit
End With
End Sub
There is simply too much info in the json to go through it all but here is a snapshot extract of the webpage on the left, and the json which relates to it on the right:

Answer 2

I tried to workout solution on your adopted code. Your table of interest is Table 2 on the page when we retrieve the URL through Excel Data Tab from web. We have to tackle two problems .
Table reference is proper. As we run the program number of times query table name is in Excel memory and is not removed even after deleting the sheet. So I have to increment table index like [Table 2 (2)] then next time [Table 2 (3)] at 3 places in the code. If we increment table index every time program will run correctly.To find out what is the index number of table ListTables() sub routine will help. I could not find a suitable way that Excel do not remember table index of a deleted sheet table.
Second necessary point is to close connection. I have added suitable code for the same.
Final code works out as following.
Sub Macro7()
'
' Macro1 Macro
'
'
Dim Cn As Variant
Dim Ticker As String
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Ticker = InputBox("Ticker")
ActiveWorkbook.Queries.Add Name:="Table 2 (18)", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Web.Page(Web.Contents(""https://finance.yahoo.com/quote/" & Ticker & "/financials?p=" & Ticker & """))," & Chr(13) & "" & Chr(10) & " Data2 = Source{2}[Data]," & Chr(13) & "" & Chr(10) & " #""Changed Type"" = Table.TransformColumnTypes(Data2,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}, {""Column4"", type text}, {""Column5"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Changed Type"""
ActiveWorkbook.Worksheets.Add
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 2 (2)"";Extended Properties=""""" _
, Destination:=Range("$A$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table 2 (18)]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_2__18"
.Refresh BackgroundQuery:=False
End With
'Range("A16").Select
For Each Cn In ThisWorkbook.Connections
Cn.Delete
Next Cn
For Each Cn In ActiveSheet.QueryTables
Cn.Delete
Next Cn
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
And code routine for listing table index is:
Sub ListTables()
Dim xTable As ListObject
Dim xSheet As Worksheet
Dim I As Long
I = -1
Sheets.Add.Name = "Table Name"
For Each xSheet In Worksheets
For Each xTable In xSheet.ListObjects
I = I + 1
Sheets("Table Name").Range("A1").Offset(I).Value = xTable.Name
Sheets("Table Name").Range("B1").Offset(I).Value = xSheet.Name
Next xTable
Next
End Sub