Добавление параметров для подключения и очистки данных из динамического URL - PullRequest
0 голосов
/ 13 июня 2019

Если я пытаюсь добавить параметры, соединяя строку URL с моими переменными, он не подключается к URL. Чтобы упростить проблему в моем коде, я жестко кодирую значения переменных, но обычно я бы извлек это из именованного диапазона.

Я пробовал расширенные запросы. Расширенная функция "Получить данные из Интернета", но, кажется, не могу добавить параметры

Sub OpenWebStockDataTest()
'
' OpenWebStockDataTest Macro
'

'
    Dim sticker As String
    Dim exchange As String

    sticker = "TGIF"
    exchange = "CN"

    ActiveWorkbook.Queries.Add Name:="Table 2", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Web.Page(Web.Contents(""https://finance.yahoo.com/quote/" & sticker & "." & exchange & "/history?p=" & sticker & "." & exchange & """))," & Chr(13) & "" & Chr(10) & "    Data2 = Source{2}[Data]," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Data2,{{""Date"", type date}, {""Open"", type number}, {""High"", type number}, {""Low"", type number}, {""Close*"", type number}, {""Adj Close**"", type number}, {""Volume"", Int64" & _
        ".Type}})" & 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"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Table 2]")
        .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"
        .Refresh BackgroundQuery:=False
    End With
End Sub

Приведенный выше код должен подключаться к: https://finance.yahoo.com/quote/TGIF.CN/history?p=TGIF.CN

Пожалуйста, помогите кому-нибудь !!!

1 Ответ

0 голосов
/ 13 июня 2019

Вы теряетесь в своих котировках.

"    Source = Web.Page(Web.Contents(""https://finance.yahoo.com/quote/"" & sticker & ""."" & exchange &""/history?p="" &sticker &"".""&exchange)),"

должно быть

"    Source = Web.Page(Web.Contents(""https://finance.yahoo.com/quote/" & sticker & "." & exchange & "/history?p=" & sticker & "." & exchange & """)),"

Редактировать:

Sub OpenWebStockDataTest()
'
' OpenWebStockDataTest Macro
'

'
    Dim sticker As String
    Dim exchange As String

    sticker = "TGIF"
    exchange = "CN"

    ActiveWorkbook.Queries.Add Name:="Table 2", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Web.Page(Web.Contents(""https://finance.yahoo.com/quote/" & sticker & "." & exchange & "/history?p=" & sticker & "." & exchange & """))," & Chr(13) & "" & Chr(10) & "    Data2 = Source{2}[Data]," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Data2,{{""Date"", type date}, {""Open"", type number}, {""High"", type number}, {""Low"", type number}, {""Close*"", type number}, {""Adj Close**"", type number}, {""Volume"", Int64" & _
        ".Type}})" & 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"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Table 2]")
        .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"
        .Refresh BackgroundQuery:=False
    End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...