Extracting data from yahoo

T

tiredofit

Well-known Member
Joined
Apr 11, 2013
Messages
1,913
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
The following code is taken from the workbook found here:

Code: 
[URL unfurl="true"]https://www.all-templates.biz/excel-programming/excel-development/oop-excel-vba/[/URL]

The part that is not working is extracting yahoo financial data:

Code: 
With Worksheets(StockName).QueryTables.Add(Connection:= _
        "TEXT;http://ichart.finance.yahoo.com/table.csv?s=" & Symbol & "&a=" & StartMonth & "&b=" & StartDay & "&c=" & StartYear & "&d=" & EndMonth & "&e=" & EndDay & "&f=" & EndYear & "&g=" & QuoteUnit _
        , Destination:=Cells(1, 1))
        .AdjustColumnWidth = True
        .TextFileParseType = xlDelimited
        .TextFileCommaDelimiter = True
        .TextFileDecimalSeparator = "."
        .Refresh BackgroundQuery:=False                                    ***** 'FAILS HERE
        End With

with an error message of:

Code: 
Run-time error '1004'

Excel cannot  access the file

'http://ichart.finance.yahoo.com/table.csv?s=X&a=0&b=1&c=2010&d='

There are several possible reasons:

The file name or path does not exist
The file is being used by another program
The workbook you are trying to save has the same name as a

Is this line of code causing the problem?

Code: 
With Worksheets(StockName).QueryTables.Add(Connection:= _
        "TEXT;http://ichart.finance.yahoo.com/table.csv?s=" & Symbol & "&a=" & StartMonth & "&b=" & StartDay & "&c=" & StartYear & "&d=" & EndMonth & "&e=" & EndDay & "&f=" & EndYear & "&g=" & QuoteUnit _
        , Destination:=Cells(1, 1))

Thanks
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Sort by date Sort by votes
Was looking at this last week. The service was disconnected some time ago.

stackoverflow.com

Yahoo Finance API changes (2017)

Requesting data from Yahoo Finance seems to have changed or is now blocked. The request below for commodity data no longer works as of May 2017. Does anyone know if there is a new way to make this
stackoverflow.com stackoverflow.com
 
Upvote 0
mrshl9898 said:
Was looking at this last week. The service was disconnected some time ago.

stackoverflow.com

Yahoo Finance API changes (2017)

Requesting data from Yahoo Finance seems to have changed or is now blocked. The request below for commodity data no longer works as of May 2017. Does anyone know if there is a new way to make this
stackoverflow.com stackoverflow.com
Click to expand...

OK

I've found this that does work:

Code: 
http://investexcel.net/multiple-stock-quote-downloader-for-excel/

What I want to do is extract the part of the code that retrieves the data.

Code: 
'Samir Khan
'simulationconsultant@gmail.com
'The latest version of this spreadsheet can be downloaded from http://investexcel.net/multiple-stock-quote-downloader-for-excel/
'Please link to http://investexcel.net if you like this spreadsheet
'Contact me for customized spreadsheets!
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

Can you tell where would that be?

Thanks
 
Upvote 0
VBA Code: 
       'Get financial data from Yahoo and write into each sheet
'getCookieCrumb() must be run before running getYahooFinanceData()

Those 2 mentioned subs look to be getting the data
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
QueryTables bug. If one query fails, all subsequent queries will fail unless restart Excel
Replies
4
Views
408
Micron
M
F
  • Question Question
Update on Automating Yahoo Finance Stock History into Excel
Replies
3
Views
2K
fred3
F
E
  • Question Question
Can anyone help me get my VBA code working? I have spent tons of time but can't quite fix it.
Replies
3
Views
3K
profray
P
J
  • Question Question
Power Query editor OR VBA to extract data from Grants.gov
Replies
3
Views
294
Jagadeshrao
J
H
  • Question Question
Macro to download zip, unpack and copy data
Replies
0
Views
655
HeinrichPaul
H

Forum statistics

Threads
1,223,236
Messages
6,170,906
Members
452,366
Latest member
TePunaBloke

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top