[英]Excel VBA_How to get historical prices form yahoo finance
I need your help for the code below.我需要您对以下代码的帮助。 From the website Yahoo finance, I try to get historical price for a ticker.
从雅虎财经网站,我尝试获取股票代码的历史价格。
The code below does not work.下面的代码不起作用。 Could you please help to fin a solution.
您能否帮助找到解决方案。
Many thanks in advance for your help.非常感谢您的帮助。
Sub URL_Get_HistokQuote()
Dim url As String
Dim sTicker As String
Dim UnixStartDate As Long
Dim UnixEndDate As Long
Dim BaseDate As Date
'Dim Cookie As String
'Dim crumb As String
sTicker = Worksheets("Sheet1").Range("B1").Value
BaseDate = DateValue("1 Jan 1970")
UnixStartDate = (Worksheets("Sheet1").Range("B2").Value - BaseDate) * 86400
UnixEndDate = (Worksheets("Sheet1").Range("B3").Value - BaseDate) * 86400
url = "URL;https://finance.yahoo.com/quote/" & sTicker & "/history?period1=" & UnixStartDate & "&period2=" & UnixEndDate & "&interval=1d&filter=history&frequency=1d"
With Worksheets("Sheet2").QueryTables.Add(Connection:=url, Destination:=Worksheets("Sheet2").Range("A1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileCommaDelimiter = True
.Refresh BackgroundQuery:=False
End With
End Sub
As I know, Yahoo shut down it's finance API almost 2 years ago.据我所知,雅虎在大约 2 年前关闭了它的财务 API。 You can try a couple other methods.
您可以尝试其他几种方法。
Sub StockMarketDataDownload()
Application.ScreenUpdating = False
On Error Resume Next
Dim Loc
Dim ws, ws2, ws3 As Worksheet
Dim EndDate, StartDate As Date
Dim Symbol, qurl As String
'Create worksheets
Sheets("Tickers").Select
Set ws = ActiveSheet
Sheets("Data").Select
Set ws2 = ActiveSheet
ws2.Cells.Clear
ws.Select
StartDate = Range("B2").Value
EndDate = Range("B3").Value
' Set Range for Loop
Dim i As Integer
Dim tickerEnd As Integer
Cells(5, 1).Select
Range(Selection, Selection.End(xlDown)).Select
tickerEnd = Selection.Rows.Count
tickerEnd = tickerEnd
Dim j As Integer
Dim idate As Integer
Dim iclose As Integer
'Loop through Column
For i = 2 To tickerEnd
j = 4 + i
iclose = i + 1
idate = 2
ws2.Cells.Clear
Range("A1").Select
ws.Select
Symbol = Cells(j, 1).Value
' ' qurl = "http://www.google.com/finance/historical?q=" & Symbol & "&output=csv"
'https://finance.google.com/finance/historical?cid=304466804484872&startdate=Aug+1%2C+2016&enddate=Oct+1%2C+2017&num=30&ei=QwXRWeCqEYiljAGdiJWoBA
'https://finance.google.com/finance/historical?q=SPY&startdate=Aug+1%2C+2016&enddate=Oct+1%2C+2017&num=30&output=csv
'https://finance.google.com/finance/historical?q=SPY&startdate=Jan+1+2016&enddate=Oct+1C+2017&num=30&output=csv
qurl = "https://finance.google.com/finance/historical?q=" _
& Symbol & "&startdate=" & Format(StartDate, "mmm") & "+" & Day(StartDate) & "+" & Year(StartDate) & _
"&enddate=" & Format(EndDate, "mmm") & "+" & Day(EndDate) & "+" & Year(EndDate) & "&num=30&output=csv"
'MsgBox qurl
ws2.Select
Query:
With Sheets("Data").QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets("Data").Range("A1"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = False
End With
Sheets("Data").Range("A1").CurrentRegion.TextToColumns Destination:=Sheets("Data").Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, other:=False
'Paste date
Cells.Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
ActiveSheet.Name = Symbol
Columns("A:A").Select
Selection.ColumnWidth = 14.29
Range("A1").Select
Next i
Application.ScreenUpdating = True
On Error GoTo 0
ErrorHandler:
End Sub
Here are a few more resources to mull over when you have a chance.当您有机会时,这里还有一些资源可以考虑。
http://investexcel.net/importing-historical-stock-prices-from-yahoo-into-excel/ http://investexcel.net/importing-historical-stock-prices-from-yahoo-into-excel/
http://investexcel.net/multiple-stock-quote-downloader-for-excel/ http://investexcel.net/multiple-stock-quote-downloader-for-excel/
https://www.signalsolver.com/download-historical-stock-price-data-excel/ https://www.signalsolver.com/download-historical-stock-price-data-excel/
https://ribon.ch/excel-vba-yahoo-finance-historical-stock-data/ https://ribon.ch/excel-vba-yahoo-finance-historical-stock-data/
https://social.technet.microsoft.com/Forums/en-US/b6ee0135-c7ea-4da8-8ac3-2fc8a76db844/converting-a-yahoogoogle-historical-stock-data-excel-macro-to-accept-barcodecom-api?forum=powerquery https://social.technet.microsoft.com/Forums/en-US/b6ee0135-c7ea-4da8-8ac3-2fc8a76db844/converting-a-yahoogoogle-historical-stock-data-excel-macro-to-accept-barcodecom- api?forum=powerquery
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.