Объединение переменных в строку для URL запроса

Question

Я пытаюсь запрограммировать динамический c URL-адрес, который меняется по мере изменения дня. Я могу заставить запрос выполняться, если я жестко закодировал дату в строку, но он не будет выполняться, когда в конце URL-адреса используется «todaysDate». Я посмотрел в окне locals, и переменная url возвращает правильную строку, необходимую для загрузки файла CSV, к которому обращается запрос. '' '

Sub historicalDataQuery(ByVal ticker As String)
Dim todaysDate As String
Dim oneYearAgo As String
Dim url As String

todaysDate = Format(Now, "YYYY-MM-DD")
oneYearAgo = Format(Now - 365, "YYYY-MM-DD")
url = "https://www.nasdaq.com/api/v1/historical/" & ticker & "/stocks/" & oneYearAgo & "/" & todaysDate
'On Error Resume Next

ActiveWorkbook.Queries.Add Name:="2020-02-23", Formula:= _
    "let" & Chr(13) & "" & Chr(10) & "    Source = Csv.Document(Web.Contents(url)),[Delimiter="","", Columns=6, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & "" & Chr(10) & "    #""Promoted Headers"" = Table.PromoteHeaders(Source, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(#""Promoted Headers"",{{""Date""," & _
    " type date}, {"" Close/Last"", Currency.Type}, {"" Volume"", Int64.Type}, {"" Open"", Currency.Type}, {"" High"", Currency.Type}, {"" Low"", Currency.Type}})," & Chr(13) & "" & Chr(10) & "    #""Removed Columns"" = Table.RemoveColumns(#""Changed Type"",{""Date"", "" Volume"", "" Open"", "" High"", "" Low""})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Removed Columns"""
Sheets.Add After:=ActiveSheet
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
    "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=2020-02-23;Extended Properties=""""" _
    , Destination:=Range("$A$1")).QueryTable
    .CommandType = xlCmdSql
    .CommandText = Array("SELECT * FROM [2020-02-23]")
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .ListObject.DisplayName = ticker
    .Refresh BackgroundQuery:=False
End With
end sub

например, я знаю, что этот код работает:

Source = Csv.Document(Web.Contents(""https://www.nasdaq.com/api/v1/historical/" & ticker & "/stocks/" oneYearAgo & "/2020-02-23"")

Answer 1

В вашем запросе была опечатка

Я также реорганизовал некоторые коды

Код:

Sub test()
    historicalDataQuery "msft"
End Sub

Sub historicalDataQuery(ByVal ticker As String)
    Dim todaysDate As String
    Dim oneYearAgo As String
    Dim url As String
    Dim queryName As String
    Dim queryString As String

    todaysDate = Format(Now, "YYYY-MM-DD")
    oneYearAgo = Format(Now - 365, "YYYY-MM-DD")
    url = "https://www.nasdaq.com/api/v1/historical/" & ticker & "/stocks/" & oneYearAgo & "/" & todaysDate

    queryName = ticker & todaysDate

    If QueryExists(queryName, ThisWorkbook) Then
        MsgBox "Query already exists"
        Exit Sub
    End If

    queryString = "let" & Chr(13) & Chr(10) & _
                  "    Source = Csv.Document(Web.Contents(""" & url & """),[Delimiter="","", Columns=6, Encoding=1252, QuoteStyle=QuoteStyle.None])," & Chr(13) & Chr(10) & _
                  "    PromoteHeaders = Table.PromoteHeaders(Source, [PromoteAllScalars=true])," & Chr(13) & Chr(10) & _
                  "    ChangeTypes = Table.TransformColumnTypes(PromoteHeaders,{{""Date"", type date}, {"" Close/Last"", Currency.Type}, {"" Volume"", Int64.Type}, {"" Open"", Currency.Type}, {"" High"", Currency.Type}, {"" Low"", Currency.Type}})," & Chr(13) & Chr(10) & _
                  "    RemoveColumns = Table.RemoveColumns(ChangeTypes,{""Date"", "" Volume"", "" Open"", "" High"", "" Low""})" & Chr(13) & Chr(10) & _
                  "in" & Chr(13) & Chr(10) & _
                  "    RemoveColumns"

    ActiveWorkbook.Queries.Add Name:=queryName, Formula:=queryString

    Sheets.Add After:=ActiveSheet

    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & queryName & ";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & queryName & "]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = ticker
        .Refresh BackgroundQuery:=False
    End With
End Sub

Function QueryExists(q$, Optional wb As Workbook) As Boolean
    ' Credits: https://gallery.technet.microsoft.com/VBA-to-automate-Power-956a52d1
    If wb Is Nothing Then Set wb = ActiveWorkbook
    On Error Resume Next
    QueryExists = CBool(Len(wb.Queries(q).Name))
    On Error GoTo 0
End Function

Дайте мне знать если это работает