Option Explicit
Private Const C_YAHOO_REQUEST_FUNC_NAME As String = "fYahooFinanceStats"
Private Const C_YAHOO_REQUEST_TABLE_NAME As String = "tYahooFinanceStats"
Private Const C_TABLE_RANGE_NAME As String = "tAktien"
Public Sub YahooWebRequest_CleanUp()
On Error Resume Next
ThisWorkbook.Queries(C_YAHOO_REQUEST_TABLE_NAME).Delete
ThisWorkbook.Queries(C_YAHOO_REQUEST_FUNC_NAME).Delete
ThisWorkbook.Names(C_TABLE_RANGE_NAME).Delete
End Sub
Public Sub YahooWebRequest_Init()
Debug.Print "#"; Time$; "#", "[START]"
Dim rngTableCol1 As Excel.Range
Dim objQuery As WorkbookQuery
Dim strQuery As String
With ThisWorkbook.Worksheets("Tabelle1")
Set rngTableCol1 = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
Call .Parent.Names.Add(C_TABLE_RANGE_NAME, rngTableCol1)
End With
strQuery = "let " & C_YAHOO_REQUEST_FUNC_NAME & " = (aktie as text) =>" & vbNewLine & _
"let" & vbNewLine & _
"Data0 = Source{0}[Data]," & vbNewLine & _
"Data0_Transposed = Table.Transpose(Data0)," & vbNewLine & _
"Data0_WithHeader = Table.PromoteHeaders(Data0_Transposed, [PromoteAllScalars=true])," & vbNewLine & _
"Data0_DataTypes = Table.TransformColumnTypes(Data0_WithHeader,{{""Previous Close"", Number.Type}}, ""en-US"")," & vbNewLine & _
"Data0_Selected = Table.SelectColumns(Data0_DataTypes,{""Previous Close""})" & vbNewLine & _
"in" & vbNewLine & _
"Data0_Selected" & vbNewLine & _
"in" & vbNewLine & _
C_YAHOO_REQUEST_FUNC_NAME
On Error Resume Next
Set objQuery = Nothing
Set objQuery = ThisWorkbook.Queries(C_YAHOO_REQUEST_FUNC_NAME)
On Error GoTo 0
If Not objQuery Is Nothing Then
Debug.Print "#"; Time$; "#", "use existing '"; C_YAHOO_REQUEST_FUNC_NAME; "'"
Else
Debug.Print "#"; Time$; "#", "create '"; C_YAHOO_REQUEST_FUNC_NAME; "'"
Set objQuery = ThisWorkbook.Queries.Add(C_YAHOO_REQUEST_FUNC_NAME, strQuery)
End If
strQuery = "let" & vbNewLine & _
"Data0 = Excel.CurrentWorkbook(){[Name=""" & C_TABLE_RANGE_NAME & """]}[Content]," & vbNewLine & _
"Data0_WithHeaders = Table.PromoteHeaders(Data0, [PromoteAllScalars=true])," & vbNewLine & _
"Data0_DataTypes = Table.TransformColumnTypes(Data0_WithHeaders,{{""Aktie"", type text}})," & vbNewLine & _
"Data0_UDF_CALL = Table.AddColumn(Data0_DataTypes, """ & C_YAHOO_REQUEST_FUNC_NAME & """, each " & C_YAHOO_REQUEST_FUNC_NAME & "([Aktie]))," & vbNewLine & _
"Data0_SelectColumns = Table.ExpandTableColumn(Data0_UDF_CALL, """ & C_YAHOO_REQUEST_FUNC_NAME & """, {""Previous Close""}, {""Previous Close""})" & vbNewLine & _
"in" & vbNewLine & _
"Data0_SelectColumns"
On Error Resume Next
Set objQuery = Nothing
Set objQuery = ThisWorkbook.Queries(C_YAHOO_REQUEST_TABLE_NAME)
On Error GoTo 0
If Not objQuery Is Nothing Then
Debug.Print "#"; Time$; "#", "use existing '"; C_YAHOO_REQUEST_TABLE_NAME; "'"
Else
Debug.Print "#"; Time$; "#", "create '"; C_YAHOO_REQUEST_TABLE_NAME; "'"
Set objQuery = ThisWorkbook.Queries.Add(C_YAHOO_REQUEST_TABLE_NAME, strQuery)
End If
With ActiveWorkbook.Worksheets.Add
With .ListObjects.Add( _
SourceType:=xlSrcExternal, _
Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & C_YAHOO_REQUEST_TABLE_NAME, _
Destination:=.Range("$A$1") _
)
With .QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [" & C_YAHOO_REQUEST_TABLE_NAME & "]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
Debug.Print "#"; Time$; "#", "start (async) request"
.Refresh
End With
End With
End With
Debug.Print "#"; Time$; "#", "[END]"
End Sub