Option Explicit
Public Const firstTickerRow As Integer = 13
Sub DownloadData()
Dim frequency As String
Dim lastRow As Integer
Dim lastErrorRow As Integer
Dim lastSuccessRow As Integer
Dim stockTicker As String
Dim numStockErrors As Integer
Dim numStockSuccess As Integer
Dim startDate As String
Dim endDate As String
Dim ticker As Integer
Dim crumb As String
Dim cookie As String
Dim validCookieCrumb As Boolean
Dim sortOrderComboBox As Shape
numStockErrors = 0
numStockSuccess = 0
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
lastErrorRow = ActiveSheet.Cells(Rows.Count, "J").End(xlUp).Row
lastSuccessRow = ActiveSheet.Cells(Rows.Count, "L").End(xlUp).Row
ClearErrorList lastErrorRow
ClearSuccessList lastSuccessRow
lastRow = ActiveSheet.Cells(Rows.Count, "a").End(xlUp).Row
frequency = Worksheets("Parameters").Range("b7")
'Convert user-specified calendar dates to Unix time
'***************************************************
startDate = (Sheets("Parameters").Range("startDate") - DateValue("January 1, 1970")) * 86400
endDate = (Sheets("Parameters").Range("endDate") - DateValue("January 1, 1970")) * 86400
'***************************************************
'Set date retrieval frequency
'***************************************************
If Worksheets("Parameters").Range("frequency") = "d" Then
frequency = "1d"
ElseIf Worksheets("Parameters").Range("frequency") = "w" Then
frequency = "1wk"
ElseIf Worksheets("Parameters").Range("frequency") = "m" Then
frequency = "1mo"
End If
'***************************************************
'Delete all sheets apart from Parameters sheet
'***************************************************
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "Parameters" And ws.Name <> "About" Then ws.Delete
Next
'***************************************************
'Get cookie and crumb
'***************************************************
Call getCookieCrumb(crumb, cookie, validCookieCrumb)
If validCookieCrumb = False Then
GoTo ErrorHandler:
End If
'***************************************************
'Loop through all tickers
For ticker = firstTickerRow To lastRow
stockTicker = Worksheets("Parameters").Range("$a$" & ticker)
If stockTicker = "" Then
GoTo NextIteration
End If
'Create a sheet for each ticker
'***************************************************
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = stockTicker
Cells(1, 1) = "Stock Quotes for " & stockTicker
'***************************************************
'Get financial data from Yahoo and write into each sheet
'getCookieCrumb() must be run before running getYahooFinanceData()
'***************************************************
Call getYahooFinanceData(stockTicker, startDate, endDate, frequency, cookie, crumb)
'***************************************************
'The Yahoo data swaps around the close and adjusted close prices - gremlin in Yahoo probably
'Let's just swap around the labels as a workaround
'***************************************************
' Sheets(stockTicker).Range("E2") = "Adjusted Close"
' Sheets(stockTicker).Range("F2") = "Close"
'Populate success or fail lists
'***************************************************
lastRow = Sheets(stockTicker).UsedRange.Row - 2 + Sheets(stockTicker).UsedRange.Rows.Count
If lastRow < 3 Then
Sheets(stockTicker).Delete
numStockErrors = numStockErrors + 1
ErrorList stockTicker, numStockErrors
GoTo NextIteration
Else
numStockSuccess = numStockSuccess + 1
If Left(stockTicker, 1) = "^" Then
SuccessList Replace(stockTicker, "^", ""), numStockSuccess
Else
SuccessList stockTicker, numStockSuccess
End If
End If
'***************************************************
'Set the preferred date format
'***************************************************
Range("a3:a" & lastRow).NumberFormat = "yyyy-mm-dd;@"
'***************************************************
'Sort by oldest date first or newest date first
'***************************************************
Set sortOrderComboBox = Sheets("Parameters").Shapes("SortOrderDropDown")
With sortOrderComboBox.ControlFormat
If .List(.Value) = "Oldest First" Then
Call SortByDate(stockTicker, "oldest")
ElseIf .List(.Value) = "Newest First" Then
Call SortByDate(stockTicker, "newest")
End If
End With
'***************************************************
'Clean up sheet names
'***************************************************
'Remove initial ^ in ticker names from Sheets
If Left(stockTicker, 1) = "^" Then
ActiveSheet.Name = Replace(stockTicker, "^", "")
Else
ActiveSheet.Name = stockTicker
End If
'Remove hyphens in ticker names from Sheet names, otherwise error in collation
If InStr(stockTicker, "-") > 0 Then
ActiveSheet.Name = Replace(stockTicker, "-", "")
End If
'***************************************************
NextIteration:
Next ticker
'Process export and collation
'***************************************************
If Sheets("Parameters").Shapes("WriteToCSVCheckBox").ControlFormat.Value = xlOn Then
On Error GoTo ErrorHandler:
Call CopyToCSV
End If
If Sheets("Parameters").Shapes("CollateDataCheckBox").ControlFormat.Value = xlOn Then
On Error GoTo ErrorHandler:
Call CollateData
End If
'***************************************************
ErrorHandler:
Worksheets("Parameters").Select
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub SortByDate(ticker As String, order As String)
Dim firstRow As Integer
Dim lastRow As Integer
Dim sortType As Variant
lastRow = Sheets(ticker).UsedRange.Rows.Count
firstRow = 2
If order = "oldest" Then
sortType = xlAscending
Else
sortType = xlDescending
End If
Worksheets(ticker).Sort.SortFields.Clear
Worksheets(ticker).Sort.SortFields.Add Key:=Sheets(ticker).Range("A" & firstRow & ":A" & lastRow), _
SortOn:=xlSortOnValues, order:=sortType, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(ticker).Sort
.SetRange Range("A" & firstRow & ":G" & lastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
Sub CollateData()
Dim ws As Worksheet
Dim i As Integer
Dim maxRow As Integer
Dim maxTickerWS As Worksheet
maxRow = 0
For Each ws In Worksheets
If ws.Name <> "Parameters" Then
If ws.UsedRange.Rows.Count > maxRow Then
maxRow = ws.UsedRange.Rows.Count
Set maxTickerWS = ws
End If
End If
Next
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Open Price"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "High Price"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Low Price"
'Correct a bug in the Yahoo Finance data
'****************************************
' Sheets.Add After:=Sheets(Sheets.Count)
' ActiveSheet.Name = "Close Price"
'
' Sheets.Add After:=Sheets(Sheets.Count)
' ActiveSheet.Name = "Trading Volume"
'
' Sheets.Add After:=Sheets(Sheets.Count)
' ActiveSheet.Name = "Adjusted Close Price"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Close Price"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Adjusted Close Price"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Trading Volume"
'****************************************
i = 1
maxTickerWS.Range("A2", "B" & maxRow).Copy Destination:=Sheets("Open Price").Cells(1, i)
Sheets("Open Price").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("High Price").Cells(1, i)
maxTickerWS.Range("c2", "c" & maxRow).Copy Destination:=Sheets("High Price").Cells(1, i + 1)
Sheets("High Price").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Low Price").Cells(1, i)
maxTickerWS.Range("d2", "d" & maxRow).Copy Destination:=Sheets("Low Price").Cells(1, i + 1)
Sheets("Low Price").Cells(1, i + 1) = maxTickerWS.Name
'Correct a bug in the Yahoo Finance data
'****************************************
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Close Price").Cells(1, i)
maxTickerWS.Range("e2", "e" & maxRow).Copy Destination:=Sheets("Close Price").Cells(1, i + 1)
Sheets("Close Price").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Adjusted Close Price").Cells(1, i)
maxTickerWS.Range("f2", "f" & maxRow).Copy Destination:=Sheets("Adjusted Close Price").Cells(1, i + 1)
Sheets("Trading Volume").Cells(1, i + 1) = maxTickerWS.Name
maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Trading Volume").Cells(1, i)
maxTickerWS.Range("g2", "g" & maxRow).Copy Destination:=Sheets("Trading Volume").Cells(1, i + 1)
Sheets("Adjusted Close Price").Cells(1, i + 1) = maxTickerWS.Name
' maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Adjusted Close Price").Cells(1, i)
' maxTickerWS.Range("e2", "e" & maxRow).Copy Destination:=Sheets("Adjusted Close Price").Cells(1, i + 1)
' Sheets("Adjusted Close Price").Cells(1, i + 1) = maxTickerWS.Name
'
' maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Close Price").Cells(1, i)
' maxTickerWS.Range("f2", "f" & maxRow).Copy Destination:=Sheets("Close Price").Cells(1, i + 1)
' Sheets("Close Price").Cells(1, i + 1) = maxTickerWS.Name
'
' maxTickerWS.Range("A2", "a" & maxRow).Copy Destination:=Sheets("Trading Volume").Cells(1, i)
' maxTickerWS.Range("g2", "g" & maxRow).Copy Destination:=Sheets("Trading Volume").Cells(1, i + 1)
' Sheets("Trading Volume").Cells(1, i + 1) = maxTickerWS.Name
'****************************************
i = i + 2
For Each ws In Worksheets
If ws.Name <> "Stacked Data" And ws.Name <> "Parameters" And ws.Name <> "About" And ws.Name <> maxTickerWS.Name And ws.Name <> "Open Price" And ws.Name <> "High Price" And ws.Name <> "Low Price" And ws.Name <> "Close Price" And ws.Name <> "Trading Volume" And ws.Name <> "Adjusted Close Price" Then
Sheets("Open Price").Cells(1, i) = ws.Name
Sheets("Open Price").Range(Sheets("Open Price").Cells(2, i), Sheets("Open Price").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A$2:G$" & maxRow & ",2,0)"
Sheets("High Price").Cells(1, i) = ws.Name
Sheets("High Price").Range(Sheets("High Price").Cells(2, i), Sheets("High Price").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A$2:G$" & maxRow & ",3,0)"
Sheets("Low Price").Cells(1, i) = ws.Name
Sheets("Low Price").Range(Sheets("Low Price").Cells(2, i), Sheets("Low Price").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A$2:G$" & maxRow & ",4,0)"
'Correct a bug in the Yahoo Finance data
'****************************************
Sheets("Close Price").Cells(1, i) = ws.Name
Sheets("Close Price").Range(Sheets("Close Price").Cells(2, i), Sheets("Close Price").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A$2:G$" & maxRow & ",5,0)"
Sheets("Adjusted Close Price").Cells(1, i) = ws.Name
Sheets("Adjusted Close Price").Range(Sheets("Adjusted Close Price").Cells(2, i), Sheets("Adjusted Close Price").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A$2:G$" & maxRow & ",6,0)"
Sheets("Trading Volume").Cells(1, i) = ws.Name
Sheets("Trading Volume").Range(Sheets("Trading Volume").Cells(2, i), Sheets("Trading Volume").Cells(maxRow - 1, i)).Formula = _
"=vlookup(A2," & ws.Name & "!A$2:G$" & maxRow & ",7,0)"
' Sheets("Adjusted Close Price").Cells(1, i) = ws.Name
' Sheets("Adjusted Close Price").Range(Sheets("Adjusted Close Price").Cells(2, i), Sheets("Adjusted Close Price").Cells(maxRow - 1, i)).Formula = _
' "=vlookup(A2," & ws.Name & "!A$2:G$" & maxRow & ",5,0)"
'
' Sheets("Close Price").Cells(1, i) = ws.Name
' Sheets("Close Price").Range(Sheets("Close Price").Cells(2, i), Sheets("Close Price").Cells(maxRow - 1, i)).Formula = _
' "=vlookup(A2," & ws.Name & "!A$2:G$" & maxRow & ",6,0)"
'
' Sheets("Trading Volume").Cells(1, i) = ws.Name
' Sheets("Trading Volume").Range(Sheets("Trading Volume").Cells(2, i), Sheets("Trading Volume").Cells(maxRow - 1, i)).Formula = _
' "=vlookup(A2," & ws.Name & "!A$2:G$" & maxRow & ",7,0)"
'****************************************
i = i + 1
End If
Next
On Error Resume Next
Sheets("Open Price").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("Close Price").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("High Price").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("Low Price").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("Trading Volume").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("Adjusted Close Price").UsedRange.SpecialCells(xlFormulas, xlErrors).Clear
Sheets("Open Price").UsedRange.Value = Sheets("Open Price").UsedRange.Value
Sheets("Close Price").UsedRange.Value = Sheets("Close Price").UsedRange.Value
Sheets("High Price").UsedRange.Value = Sheets("High Price").UsedRange.Value
Sheets("Low Price").UsedRange.Value = Sheets("Low Price").UsedRange.Value
Sheets("Trading Volume").UsedRange.Value = Sheets("Trading Volume").UsedRange.Value
Sheets("Adjusted Close Price").UsedRange.Value = Sheets("Adjusted Close Price").UsedRange.Value
On Error GoTo 0
Sheets("Open Price").Columns("A:A").EntireColumn.AutoFit
Sheets("High Price").Columns("A:A").EntireColumn.AutoFit
Sheets("Low Price").Columns("A:A").EntireColumn.AutoFit
Sheets("Close Price").Columns("A:A").EntireColumn.AutoFit
Sheets("Trading Volume").Columns("A:A").EntireColumn.AutoFit
Sheets("Adjusted Close Price").Columns("A:A").EntireColumn.AutoFit
End Sub
Sub SuccessList(ByVal stockTicker As String, ByVal numStockSuccess As Integer)
Sheets("Parameters").Range("L" & 10 + numStockSuccess) = stockTicker
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlDiagonalUp).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeLeft).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeTop).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeBottom).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeRight).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlInsideVertical).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlInsideHorizontal).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlDiagonalUp).LineStyle = xlNone
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlInsideVertical).LineStyle = xlNone
Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Borders(xlInsideHorizontal).LineStyle = xlNone
With Sheets("Parameters").Range("L10:L" & 10 + numStockSuccess).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End Sub
Sub ErrorList(ByVal stockTicker As String, ByVal numStockErrors As Integer)
Sheets("Parameters").Range("J" & 10 + numStockErrors) = stockTicker
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlDiagonalUp).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeLeft).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeTop).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeBottom).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeRight).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlInsideVertical).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlInsideHorizontal).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlDiagonalDown).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlDiagonalUp).LineStyle = xlNone
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlInsideVertical).LineStyle = xlNone
Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Borders(xlInsideHorizontal).LineStyle = xlNone
With Sheets("Parameters").Range("J10:J" & 10 + numStockErrors).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End Sub
Sub ClearErrorList(ByVal lastErrorRow As Integer)
If lastErrorRow > 10 Then
Worksheets("Parameters").Range("J11:J" & lastErrorRow).Clear
With Sheets("Parameters").Range("J10").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("J10").Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
End If
End Sub
Sub ClearSuccessList(ByVal lastSuccessRow As Integer)
If lastSuccessRow > 10 Then
Worksheets("Parameters").Range("L11:L" & lastSuccessRow).Clear
With Sheets("Parameters").Range("L10").Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10").Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10").Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Sheets("Parameters").Range("L10").Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
End If
End Sub
Sub CopyToCSV()
Dim MyPath As String
Dim MyFileName As String
Dim dateFrom As Date
Dim dateTo As Date
Dim frequency As String
Dim ws As Worksheet
Dim ticker As String
dateFrom = Worksheets("Parameters").Range("$b$5")
dateTo = Worksheets("Parameters").Range("$b$6")
frequency = Worksheets("Parameters").Range("$b$7")
MyPath = Worksheets("Parameters").Range("$b$8")
For Each ws In Worksheets
If ws.Name <> "Parameters" And ws.Name <> "About" Then
ticker = ws.Name
MyFileName = ticker & " " & Format(dateFrom, "dd-mm-yyyy") & " - " & Format(dateTo, "dd-mm-yyyy") & " " & frequency
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
Sheets(ticker).Copy
With ActiveWorkbook
.SaveAs Filename:= _
MyPath & MyFileName, _
FileFormat:=xlCSV, _
CreateBackup:=False
.Close False
End With
End If
Next
End Sub
Sub getCookieCrumb(crumb As String, cookie As String, validCookieCrumb As Boolean)
Dim i As Integer
Dim str As String
Dim crumbStartPos As Long
Dim crumbEndPos As Long
Dim objRequest
validCookieCrumb = False
For i = 0 To 5 'ask for a valid crumb 5 times
Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
With objRequest
.Open "GET", "https://finance.yahoo.com/lookup?s=bananas", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
.send
.waitForResponse (10)
cookie = Split(.getResponseHeader("Set-Cookie"), ";")(0)
'crumbStartPos = InStr(1, .ResponseText, """CrumbStore"":{""crumb"":""", vbBinaryCompare) + Len("""CrumbStore"":{""crumb"":""")
crumbStartPos = InStrRev(.ResponseText, """crumb"":""") + 9
crumbEndPos = crumbStartPos + 11 'InStr(crumbStartPos, .ResponseText, """", vbBinaryCompare)
crumb = Mid(.ResponseText, crumbStartPos, crumbEndPos - crumbStartPos)
'Sheets("Parameters").Range("C30") = crumbStartPos
'Sheets("Parameters").Range("C31") = crumbEndPos
'Sheets("Parameters").Range("c32") = crumb
End With
If Len(crumb) = 11 Then 'a valid crumb is 11 characters long
validCookieCrumb = True
Exit For
End If:
' If i = 5 Then ' no valid crumb
' validCookieCrumb = False
' End If
Next i
End Sub
Sub getYahooFinanceData(stockTicker As String, startDate As String, endDate As String, frequency As String, cookie As String, crumb As String)
Dim resultFromYahoo As String
Dim objRequest
Dim csv_rows() As String
Dim resultArray As Variant
Dim nColumns As Integer
Dim iRows As Integer
Dim CSV_Fields As Variant
Dim iCols As Integer
Dim tickerURL As String
'Construct URL
'***************************************************
tickerURL = "https://query1.finance.yahoo.com/v7/finance/download/" & stockTicker & _
"?period1=" & startDate & _
"&period2=" & endDate & _
"&interval=" & frequency & "&events=history" & "&crumb=" & crumb
'Sheets("Parameters").Range("K" & ticker - 1) = tickerURL
'***************************************************
'Get data from Yahoo
'***************************************************
Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
With objRequest
.Open "GET", tickerURL, False
.setRequestHeader "Cookie", cookie
.send
.waitForResponse
resultFromYahoo = .ResponseText
End With
'***************************************************
'Parse returned string into an array
'***************************************************
nColumns = 6 'number of columns minus 1 (date, open, high, low, close, adj close, volume)
csv_rows() = Split(resultFromYahoo, Chr(10))
ReDim resultArray(0 To UBound(csv_rows), 0 To nColumns) As Variant
For iRows = LBound(csv_rows) To UBound(csv_rows)
CSV_Fields = Split(csv_rows(iRows), ",")
If UBound(CSV_Fields) > nColumns Then
nColumns = UBound(CSV_Fields)
ReDim Preserve resultArray(0 To UBound(csv_rows), 0 To nColumns) As Variant
End If
For iCols = LBound(CSV_Fields) To UBound(CSV_Fields)
If IsNumeric(CSV_Fields(iCols)) Then
resultArray(iRows, iCols) = Val(CSV_Fields(iCols))
ElseIf IsDate(CSV_Fields(iCols)) Then
resultArray(iRows, iCols) = CDate(CSV_Fields(iCols))
Else
resultArray(iRows, iCols) = CStr(CSV_Fields(iCols))
End If
Next
Next
'Write results into worksheet for ticker
Sheets(stockTicker).Range("A2").Resize(UBound(resultArray, 1) + 1, UBound(resultArray, 2) + 1).Value = resultArray
'***************************************************
End Sub