I am trying to program a dynamic url that changes as the day changes. I can get the query to run if I hardcode the date into the string but it will not run when “todaysDate” is used at the end of the url. I looked in the locals window and the variable url returns the correct string needed to download the csv file that the query calls for. ”’
x
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
for example, I know that this code works:
Source = Csv.Document(Web.Contents(""https://www.nasdaq.com/api/v1/historical/" & ticker & "/stocks/" oneYearAgo & "/2020-02-23"")
Advertisement
Answer
You had a typo in your query definition
I also refactored some of the code
Code:
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
Let me know if it works