Excel VBA_如何从Yahoo财务获取历史价格

Question

我需要您提供以下代码的帮助。从雅虎财经网站，我尝试获取股票的历史价格。

下面的代码不起作用。您能帮忙找到解决方案吗？

非常感谢您的帮助。

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

Answer 1

[据我所知，雅虎将近两年前关闭了它的财务API。您可以尝试其他几种方法。

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

这里有更多资源可供您考虑。

http://investexcel.net/importing-historical-stock-prices-from-yahoo-into-excel/

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

https://www.signalsolver.com/download-historical-stock-price-data-excel/

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