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