Macro to import historical data using web query

[Dome92]

Hi all, I'm trying to create a macro that imports historical data from Yahoo finance using the web query.


My inputs are 1) the ticker, 2) start date, 3) end date, 4) data frequency (daily, weekly, monthly).


I'm now stuck with this error: "Unable to fetch data from yahoo finance"




Option Explicit


Sub GetDataFromYahooFinance()
Dim ticker As String
Dim startDate As Date
Dim endDate As Date
Dim frequency As String
Dim url As String
Dim xmlhttp As Object
Dim data As String
Dim i As Integer

' Set the ticker based on user input
ticker = InputBox("Enter the ticker symbol:")

' Exit the macro if the user cancels the ticker input box or leaves it blank
If ticker = "" Then Exit Sub

' Get the start date, end date, and data frequency from the user
On Error Resume Next
startDate = DateValue(InputBox("Enter the start date (YYYY-MM-DD):"))
endDate = DateValue(InputBox("Enter the end date (YYYY-MM-DD):"))
On Error GoTo 0

' Exit the macro if the user cancels the date input boxes or provides invalid dates
If startDate = 0 Or endDate = 0 Then Exit Sub

' Ask the user to select the data frequency
frequency = Application.InputBox("Select the data frequency:" & vbNewLine & _
"1 - Daily" & vbNewLine & _
"2 - Weekly" & vbNewLine & _
"3 - Monthly", Type:=1)

' Exit the macro if the user cancels the frequency input box or provides invalid input
If Not IsNumeric(frequency) Then Exit Sub

' Convert the frequency input to the corresponding interval for Yahoo Finance
Dim interval As String
Select Case CInt(frequency)
Case 1 ' Daily
interval = "1d"
Case 2 ' Weekly
interval = "1wk"
Case 3 ' Monthly
interval = "1mo"
Case Else
MsgBox "Invalid data frequency selection."
Exit Sub
End Select

' Convert the start and end dates to Unix timestamps
Dim startDateUnix As Long
startDateUnix = CLng(startDate - DateSerial(1970, 1, 1))

Dim endDateUnix As Long
endDateUnix = CLng(endDate - DateSerial(1970, 1, 1))

' Create the URL to fetch historical data (Yahoo Finance)
url = "https://query1.finance.yahoo.com/v8/finance/download/" & ticker & _
"?period1=" & startDateUnix & "&period2=" & endDateUnix & "&interval=" & interval

' Create a new XMLHTTP object
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")

' Open the URL and send the GET request
xmlhttp.Open "GET", url, False
xmlhttp.send

' Check if the request was successful (status code 200)
If xmlhttp.Status = 200 Then
' Get the response as a string
data = xmlhttp.responseText

' Split the response into lines to extract data
Dim lines As Variant
lines = Split(data, vbNewLine)

' Clear existing data on the sheet
ActiveSheet.Cells.ClearContents

' Loop through the data and populate it in the Excel sheet starting from cell A1
For i = 0 To UBound(lines)
Dim rowData As Variant
rowData = Split(lines(i), ",")
If UBound(rowData) = 7 Then ' Assuming the data has Date, Open, High, Low, Close, Adj Close and Volume columns
Cells(i + 1, 1).Value = rowData(0) ' Date
Cells(i + 1, 2).Value = rowData(4) ' Close
End If
Next i

' Format the date column as Date type
Columns(1).NumberFormat = "yyyy-mm-dd"
Else
MsgBox "Error: Unable to fetch data from Yahoo Finance."
End If
End Sub




Thanks for your help :)

[Aussiebear]

Have you looked at this as an alternative option? https://www.youtube.com/watch?v=HZU2OtDa2eI

[Dome92]

Thanks for the link, I have Chrome 111.0.5563.147 and it seems that browser automation is not supported anymore :(

[Aussiebear]

Are you using Office 365?

[Dome92]

Yes

[georgiboy]

A few issues i have spotted in the original code:

URL issue:
Have replaced:
"https://query1.finance.yahoo.com/v8/finance/download/" & ticker & _
"?period1=" & startDateUnix & "&period2=" & endDateUnix & "&interval=" & interval

With:
"https://query1.finance.yahoo.com/v7/finance/download/" & ticker & _
"?period1=" & startDateUnix & "&period2=" & endDateUnix & "&interval=" & interval & "&events=history&includeAdjustedClose=true"

Replaced the UNIX time stamp from: (as it needs to be the number of seconds since 01/01/1970)

startDateUnix = CLng(startDate - DateSerial(1970, 1, 1))
endDateUnix = CLng(endDate - DateSerial(1970, 1, 1))

To:

startDateUnix = DateDiff("s", DateSerial(1970, 1, 1), startDate)
endDateUnix = DateDiff("s", DateSerial(1970, 1, 1), endDate)

I changed the last bit of code to produce the entire table of results.

See if the below gets you any closer to where you want to be:

Sub GetDataFromYahooFinance()
Dim ticker As String
Dim startDate As Date
Dim endDate As Date
Dim frequency As String
Dim url As String
Dim xmlhttp As Object
Dim data As String
Dim lines As Variant
Dim lVar As Variant
Dim x As Long

' Set the ticker based on user input
ticker = InputBox("Enter the ticker symbol:", , "MSFT")

' Exit the macro if the user cancels the ticker input box or leaves it blank
If ticker = "" Then Exit Sub

' Get the start date, end date, and data frequency from the user
On Error Resume Next
startDate = DateValue(InputBox("Enter the start date (YYYY-MM-DD):", , "2023-07-01"))
endDate = DateValue(InputBox("Enter the end date (YYYY-MM-DD):", , "2023-07-25"))
On Error GoTo 0

' Exit the macro if the user cancels the date input boxes or provides invalid dates
If startDate = 0 Or endDate = 0 Then Exit Sub

' Ask the user to select the data frequency
frequency = Application.InputBox("Select the data frequency:" & vbNewLine & _
"1 - Daily" & vbNewLine & _
"2 - Weekly" & vbNewLine & _
"3 - Monthly", Type:=1, Default:=1)

' Exit the macro if the user cancels the frequency input box or provides invalid input
If Not IsNumeric(frequency) Then Exit Sub

' Convert the frequency input to the corresponding interval for Yahoo Finance
Dim interval As String
Select Case CInt(frequency)
Case 1 ' Daily
interval = "1d"
Case 2 ' Weekly
interval = "1wk"
Case 3 ' Monthly
interval = "1mo"
Case Else
MsgBox "Invalid data frequency selection."
Exit Sub
End Select

' Convert the start and end dates to Unix timestamps
Dim startDateUnix As Long
startDateUnix = DateDiff("s", DateSerial(1970, 1, 1), startDate)

Dim endDateUnix As Long
endDateUnix = DateDiff("s", DateSerial(1970, 1, 1), endDate)

' Create the URL to fetch historical data (Yahoo Finance)
url = "https://query1.finance.yahoo.com/v7/finance/download/" & ticker & _
"?period1=" & startDateUnix & "&period2=" & endDateUnix & "&interval=" & interval & "&events=history&includeAdjustedClose=true"

' Create a new XMLHTTP object
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")

' Open the URL and send the GET request
xmlhttp.Open "GET", url, False
xmlhttp.send

' Check if the request was successful (status code 200)
If xmlhttp.Status = 200 Then
' Get the response as a string
data = xmlhttp.responseText
lines = Split(data, Chr(10))
For x = 0 To UBound(lines)
lVar = Split(lines(x), ",")
Range("A" & x + 1).Resize(, UBound(lVar) + 1) = lVar
Next x
' Format the date column as Date type
Columns(1).NumberFormat = "yyyy-mm-dd"
Else
MsgBox "Error: Unable to fetch data from Yahoo Finance."
End If
End Sub

[georgiboy]

I will attach a formula option to play with, will only work with stats pulled within one year, not split over 2.

[Dome92]

Thank you very much both your fix to my code than the spreadsheet are great and work perfectly!

:)

[georgiboy]

You are welcome, I would say the formula option could be less reliable due to the way the data has been split - Worth noting.

[Aussiebear]

As an aside note, did you experiment with excel's StockHistory function?