VBA Macros Provide Yahoo Stock Quote Downloads in Excel 2007

• Download VBA export file with source code - 4.2 KB

Introduction

Provides a set of VBA macros and functions to download and parse live stock quotes from Yahoo Finance via the Yahoo Query Language.

Background

Back when Office 97 was launched, Microsoft added a cool new feature: Web Queries. Where before if you wanted live data, like stock quotes, you had to write your own "screen-scraper", now you could let Office do the heavy lifting. It was subject to occasional hiccups when page design/layout changed, but was often easy enough to repair. As time went on, however, more and more websites made it more and more difficult to use Web Queries, at least for the sort of data I wanted for multiple stocks: Open Price, High Price, Low Price, Current/Closing Price, Volume, Time of last Trade.

For a while, Google's finance API was a favored alternative, however Google recently shut that down in favor of using built-in Google Docs functionality.

In the last few months, the most recent website I used for multiple quotes made some change that rendered my spreadsheet and its web queries non-operational. Research for other sites turned up the aforementioned, abandoned Google Finance API. I found several references to Yahoo Finance, both for historical quote data and for downloads via CSV files (including this add-in), but nothing that would allow data downloads for multiple stocks (and without intermediate files).

I found some code that made calls through YQL (the Yahoo Query Language) to download data directly, such as this article, that gave me some ideas. There were other articles too, but I did not record all of the references (apologies). With some trial and error, I came up with this set of VBA macros that I am now using in Excel 2007 (32-bit).

One good way to get a feel for what YQL can do is to play with the console; here's a link that will, when you press the TEST button on the target page, show you the XML returned when quotes are requested for Yahoo, Apple, Google and Microsoft.

The VBA code I developed is designed to be used in a spreadsheet where calls are made serially for each stock symbol, resulting in the return of multiple quotes with access to much more data than I'd ever found on web sites I could access with Excel's Web Queries. Once more for emphasis: I've tested these macros on Excel 2007 (32-bit) only. Further disclosure: all work was also on Windows 7 x64. Your mileage may vary.

Important note: Before you can use this VBA code in Excel, make sure you've included Microsoft XML v6 (from within the Microsoft Visual Basic app, click on the Tools Menu, then click on References).

Using the Code

The heart of this VBA code is the function GetQuoteXmlFromWeb.

 Function GetQuoteXmlFromWeb(stockSymbol As String) As MSXML2.IXMLDOMNode
    ' This is an Excel VBA function which returns XML data on a stock from
    ' Yahoo Finance's XML stream.
    ' GO TO TOOLS/REFERENCES and include Microsoft XML (tested w/ v6)
    
    ' Returns the XML Node List (or Nothing on error/failure)
    
    Dim QuoteXMLstream As MSXML2.DOMDocument
    Dim QuoteXMLHttp As MSXML2.XMLHTTP60
    
    Dim oChild As MSXML2.IXMLDOMNode
    
    Dim fSuccess As Boolean
    Dim URL As String
    
    On Error GoTo HandleErr
    
    ' create the URL that requests the XML stream from Yahoo Finance
    URL = "http://query.yahooapis.com/v1/public/yql?_
          q=SELECT%20*%20FROM%20yahoo.finance.quotes%20WHERE%20symbol%3D'" & Trim(stockSymbol) & "'"
    URL = URL & "&diagnostics=false&env=store%3A%2F%2Fdatatables.org%2Falltableswithkeys"
    
    ' pull in the XML stream
    Set QuoteXMLHttp = New MSXML2.XMLHTTP60
    With QuoteXMLHttp
        Call .Open("GET", URL, False)
        Call .send
    End With
    fSuccess = QuoteXMLHttp.Status
    
    If Not fSuccess Then                          ' quit on failure
      MsgBox "error loading Yahoo Finance XML stream"
      Exit Function
    End If
    
    ' Turn it into an XML document
    Set QuoteXMLstream = New MSXML2.DOMDocument
    fSuccsss = QuoteXMLstream.LoadXML(QuoteXMLHttp.responseText)
   
    If Not fSuccess Then                          ' quit on failure
      MsgBox "error parsing Yahoo Finance XML stream"
      Exit Function
    End If
    
    ' Structure is: query.results.quote (3 children in) to get to our quote params
    Set oChild = FindChildNodeName(QuoteXMLstream.ChildNodes, "query")
    If oChild Is Nothing Then
      MsgBox "error loading Yahoo Finance XML stream: cannot find 'query'"
      Exit Function
    End If
    
    Set oChild = FindChildNodeName(oChild.ChildNodes, "results")
    If oChild Is Nothing Then
      MsgBox "error loading Yahoo Finance XML stream: cannot find 'results'"
      Exit Function
    End If
    ' If this works, we will have the XML quote data node -- our target
    Set oChild = FindChildNodeName(oChild.ChildNodes, "quote")
    
    Set GetQuoteXmlFromWeb = oChild     ' Either the node or NOTHING
        
' error handlers
ExitHere:
            Exit Function
HandleErr:
            MsgBox "GetQuoteXmlFromWeb Error " & Err.Number & ": " & Err.Description
            Resume ExitHere
End Function

The function takes a single argument: the stock symbol whose quote data you wish to retrieve. Note the use of the FindChildNodeName function to parse the result:

  ' Given an XML Dom Nodelist, find one of the child nodes whose name matches childName;
' return that node, else Nothing if not found.
'
Function FindChildNodeName(xmlChildren As MSXML2.IXMLDOMNodeList, childName As String) _
    As MSXML2.IXMLDOMNode
    Dim oChild As MSXML2.IXMLDOMNode
    Dim childResult As MSXML2.IXMLDOMNode
    
    Set childResult = Nothing
    
    For i = 1 To xmlChildren.Length
        Set oChild = xmlChildren.Item(i - 1)    ' 0-based index
        If oChild.nodeName = childName Then
            Set childResult = oChild
            Exit For
        End If
    Next
    
    ' childResult is either Nothing or the value we found
    Set FindChildNodeName = childResult
End Function 

The set of node names searched out in the initial return from Yahoo, QuoteXMLstream.ChildNodes, is based on the observed XML returned by Yahoo:

1. Find the child node, then within that
2. Find the results node, then within that
3. Find the query node; this is where the data we want resides

If the desired nodes cannot be found, then null is returned. On success, the XML data for the desired stock has been returned as an MSXML2.IXMLDOMNode object. We can now extract any of the quote data within it by calling the GetQuoteFromXml function:

Function GetQuoteFromXml(stockXml As MSXML2.IXMLDOMNode, Optional QuoteParameter As String = _
     "LastTradePriceOnly", Optional statusText As String = "") As String

    ' This is an Excel VBA function which returns data about a stock
    ' from a Yahoo Finance XML stream
    ' GO TO TOOLS/REFERENCES and include Microsoft XML (tested w/ v6)
    
    ' For numeric values, call with Value() surrounding the result
    
    ' "stockXml" is the XML data returned by GetQuoteXmlFromWeb
    ' "statusText" is "" for no status bar updates, else the text to prepend to QuoteParameter 
    ' which we write to the status bar.
    ' it is up to the caller to enable status bar updates (i.e. set Application.DisplayStatusBar = True)
    ' "QuoteParameter" is one of the following node names, it defaults to "LastTradePriceOnly":
    '
'<?xml version="1.0" encoding="UTF-8"?>
'<query xmlns:yahoo="http://www.yahooapis.com/v1/base.rng"
'    yahoo:count="1" yahoo:created="2014-01-22T00:54:50Z" yahoo:lang="en-US">
'    <results>
'        <quote symbol="MSFT">
'            <Ask>36.16</Ask>
'            <AverageDailyVolume>41359300</AverageDailyVolume>
'            <Bid>36.09</Bid>
'            <AskRealtime>36.16</AskRealtime>
'            <BidRealtime>36.09</BidRealtime>
'            <BookValue>9.782</BookValue>
'            <Change_PercentChange>-0.21 - -0.58%</Change_PercentChange>
'            <Change>-0.21</Change>
'            <Commission/>
'            <ChangeRealtime>-0.21</ChangeRealtime>
'            <AfterHoursChangeRealtime>N/A - N/A</AfterHoursChangeRealtime>
'            <DividendShare>0.97</DividendShare>
'            <LastTradeDate>1/21/2014</LastTradeDate>
'            <TradeDate/>
'            <EarningsShare>2.671</EarningsShare>
'            <ErrorIndicationreturnedforsymbolchangedinvalid/>
'            <EPSEstimateCurrentYear>2.66</EPSEstimateCurrentYear>
'            <EPSEstimateNextYear>2.88</EPSEstimateNextYear>
'            <EPSEstimateNextQuarter>0.66</EPSEstimateNextQuarter>
'            <DaysLow>36.06</DaysLow>
'            <DaysHigh>36.82</DaysHigh>
'            <YearLow>27.00</YearLow>
'            <YearHigh>38.98</YearHigh>
'            <HoldingsGainPercent>- - -</HoldingsGainPercent>
'            <AnnualizedGain/>
'            <HoldingsGain/>
'            <HoldingsGainPercentRealtime>N/A - N/A</HoldingsGainPercentRealtime>
'            <HoldingsGainRealtime/>
'            <MoreInfo>cn</MoreInfo>
'            <OrderBookRealtime/>
'            <MarketCapitalization>301.9B</MarketCapitalization>
'            <MarketCapRealtime/>
'            <EBITDA>31.367B</EBITDA>
'            <ChangeFromYearLow>+9.17</ChangeFromYearLow>
'            <PercentChangeFromYearLow>+33.96%</PercentChangeFromYearLow>
'            <LastTradeRealtimeWithTime>N/A - &lt;b&gt;36.17&lt;/b&gt;</LastTradeRealtimeWithTime>
'            <ChangePercentRealtime>N/A - -0.58%</ChangePercentRealtime>
'            <ChangeFromYearHigh>-2.81</ChangeFromYearHigh>
'            <PercebtChangeFromYearHigh>-7.21%</PercebtChangeFromYearHigh>
'            <LastTradeWithTime>Jan 21 - &lt;b&gt;36.17&lt;/b&gt;</LastTradeWithTime>
'            <LastTradePriceOnly>36.17</LastTradePriceOnly>
'            <HighLimit/>
'            <LowLimit/>
'            <DaysRange>36.06 - 36.82</DaysRange>
'            <DaysRangeRealtime>N/A - N/A</DaysRangeRealtime>
'            <FiftydayMovingAverage>37.0421</FiftydayMovingAverage>
'            <TwoHundreddayMovingAverage>34.7513</TwoHundreddayMovingAverage>
'            <ChangeFromTwoHundreddayMovingAverage>+1.4187</ChangeFromTwoHundreddayMovingAverage>
'            <PercentChangeFromTwoHundreddayMovingAverage>+4.08%
'            </PercentChangeFromTwoHundreddayMovingAverage>
'            <ChangeFromFiftydayMovingAverage>-0.8721</ChangeFromFiftydayMovingAverage>
'            <PercentChangeFromFiftydayMovingAverage>-2.35%</PercentChangeFromFiftydayMovingAverage>
'            <Name>Microsoft Corpora</Name>
'            <Notes/>
'            <Open>36.81</Open>
'            <PreviousClose>36.38</PreviousClose>
'            <PricePaid/>
'            <ChangeinPercent>-0.58%</ChangeinPercent>
'            <PriceSales>3.78</PriceSales>
'            <PriceBook>3.72</PriceBook>
'            <ExDividendDate>Nov 19</ExDividendDate>
'            <PERatio>13.62</PERatio>
'            <DividendPayDate>Mar 13</DividendPayDate>
'            <PERatioRealtime/>
'            <PEGRatio>1.93</PEGRatio>
'            <PriceEPSEstimateCurrentYear>13.68</PriceEPSEstimateCurrentYear>
'            <PriceEPSEstimateNextYear>12.63</PriceEPSEstimateNextYear>
'            <Symbol>MSFT</Symbol>
'            <SharesOwned/>
'            <ShortRatio>1.80</ShortRatio>
'            <LastTradeTime>4:00pm</LastTradeTime>
'            <TickerTrend>&amp;nbsp;===+==&amp;nbsp;</TickerTrend>
'            <OneyrTargetPrice>37.01</OneyrTargetPrice>
'            <Volume>31578980</Volume>
'            <HoldingsValue/>
'            <HoldingsValueRealtime/>
'            <YearRange>27.00 - 38.98</YearRange>
'            <DaysValueChange>- - -0.58%</DaysValueChange>
'            <DaysValueChangeRealtime>N/A - N/A</DaysValueChangeRealtime>
'            <StockExchange>NasdaqNM</StockExchange>
'            <DividendYield>2.67</DividendYield>
'            <PercentChange>-0.58%</PercentChange>
'        </quote>
'    </results>
'</query>
    
    Dim oChild As MSXML2.IXMLDOMNode
    Dim sText As String
    
    On Error GoTo HandleErr
    If statusText <> "" Then
        sText = statusText & " - " & QuoteParameter
    Else
        sText = ""
    End If
        
    For Each oChild In stockXml.ChildNodes
        If sText <> "" Then
            Application.StatusBar = sText & " (found " & oChild.nodeName & ")"
        End If
        If oChild.nodeName = QuoteParameter Then
            s = oChild.Text
            GetQuoteFromXml = s
            If sText <> "" Then Application.StatusBar = sText
            Exit Function
        End If
    Next oChild
    If sText <> "" Then Application.StatusBar = sText & " not found!"
        
' error handlers
ExitHere:
            Exit Function
HandleErr:
            MsgBox "GetQuoteFromXml Error " & Err.Number & ": " & Err.Description
            Resume ExitHere
            Resume
End Function 

The expected XML structure is included as a reference; it lets you know what values are available.

How might this be used? Let's say you have several rows in an Excel sheet laid out as follows (Excel 2007 screenshot):

The symbols to be queried appear in Column A; the only odd looking one, ^GSPC, is what Yahoo uses for the S&P 500 Index. The rest of the columns are the ones I want to populate with real quote data, refreshed on demand.

The VBA functions above were designed to be called in this manner:

1. Load quote data for a symbol with GetQuoteXmlFromWeb.
2. Fetch desired quote data from the result with multiple calls to GetQuoteFromXML.

This design allows a single web services call to be made for each stock symbol; the web data returned is saved long enough to extract all the desired information. Repeat until all symbols have been retrieved and parsed. You could refactor things to have GetQuoteXmlFromWeb accept multiple symbols and GetQuoteFromXML accept both a symbol and a data value name. I decided to break it out this way for simplicity. Data for multiple stock symbols is retrieved by using a macro to loop through the data sheet:

' for all sequential symbols in A2 and on down.
'
' manageCalcStatus = TRUE if we should turn Autocalc off then restore, or FALSE if caller does it
'
Sub UpdatePriceData(Optional manageCalcStatus As Boolean = True)
    Dim stockXml As MSXML2.IXMLDOMNode
    Dim stockData(5) As Double ' Open, High, Low, Current/Close, Volume
    Dim stockDate As Date   ' Last Trade Date
    Dim stockTime As Date   ' Last Trade time
    
    sbState = Application.DisplayStatusBar  ' save current state
    Application.DisplayStatusBar = True     ' take over status bar
    Application.StatusBar = "Preparing quote request..."
 
    If manageCalcStatus Then
        appCalcStatus = Application.Calculation
        Application.Calculation = xlCalculationManual
    End If
    
    ' Activate the sheet and get to the last row
    Sheets("Price Data").Select
    Range("A2").Select
    Selection.End(xlDown).Select
    
    ' Capture the row number, then start the loop
    iRowLast = ActiveCell.Row
    For i = 2 To iRowLast
        ' For each stock row, get the XML data for the stock and write it to the row
        Range("A" & i).Select
        Application.StatusBar = "Get quote for: " & ActiveCell.Value
        Set stockXml = GetQuoteXmlFromWeb(ActiveCell.Value)
        ' test for Nothing
        If stockXml Is Nothing Then
            ' Could not find it -- all 0's and set date to today
            For n = 0 To UBound(stockData) - 1
                stockData(n) = 0
            Next n
            stockDate = Date
            stockTime = 0
        Else
            ' Got the data... get each piece
            stockData(0) = Val(GetQuoteFromXml(stockXml, "Open"))
            stockData(1) = Val(GetQuoteFromXml(stockXml, "DaysHigh"))
            stockData(2) = Val(GetQuoteFromXml(stockXml, "DaysLow"))
            stockData(3) = Val(GetQuoteFromXml(stockXml, "LastTradePriceOnly"))
            stockData(4) = Val(GetQuoteFromXml(stockXml, "Volume"))
            
            stockDate = CDate(GetQuoteFromXml(stockXml, "LastTradeDate"))
            stockTime = TimeValue(GetQuoteFromXml(stockXml, "LastTradeTime"))
            ' Resets status bar text if GetQUoteFromXml was tweaking it
            Application.StatusBar = "Get quote for: " & ActiveCell.Value
        End If
        
        ' Now assign values out to cells the current row (B to F, then G)
        For n = 0 To UBound(stockData) - 1
            Range(Chr(Asc("B") + n) & i).Value = stockData(n)
        Next n
         Range(Chr(Asc("B") + UBound(stockData)) & i).Value = stockDate
         Range(Chr(Asc("B") + 1 + UBound(stockData)) & i).Value = stockTime
    Next i
        
    If manageCalcStatus Then
        Application.StatusBar = "Resetting calculation state..."
        Application.Calculation = appCalcStatus           ' restore calculation mode too
    End If
    Application.StatusBar = False           ' this RESTORES default text to the status bar... honest!
    Application.DisplayStatusBar = sbState  ' return control to original state

End Sub 

This macro loads a worksheet named "Price Data"; replaces that with whatever sheet name you'd like to use. This sheet is expected to be laid out as shown above. The loop starts at row 2 and goes through all contiguous symbols in column A. The status bar is updated as we go, but for a quick Internet connection it goes rather quickly, if not slowed down by automatic Recalculation (which, by default, this macro will disable while data is fetched).

Each symbol is run through GetQuoteXmlFromWeb, and if successful, the values for Open (opening price), DaysHigh (high price), DaysLow (low price), LastTradePriceOnly (the current or closing price sans timestamp), and Volume (volume of shares traded) are extracted into the Double-precision array stockData. Note that the VBA Val() method is used to convert the text returned into numbers.

Separate calls are also made to capture the LastTradeDate (which is converted with CDate()) and LastTradeTime (converted with TimeValue()) as these require different data types. Then, we iterate through the sheet columns for the currently selected row (note that Asc(Chr("B") + 0) is "B", Asc(Chr("B") + 1) is "C", etc.), outputting each value in turn. Then it is on to the next row.

Once UpdatePriceData() has completed its loops, columns B - H will contain the latest data, which is displayed with whatever formatting you decided to apply to those columns.

For my particular workbook, I placed a button in the first sheet which, when clicked, invokes UpdatePriceData(), then returns the focus to that initial sheet.

The VBA code, ready to be imported, may be downloaded as Quotes.zip.

Points of Interest

My workbook runs several calculations with the current day's data and a few years worth of historical data stored elsewhere in the workbook (other macros/functions not shown take care of archiving each day's data as needed), then plots the results. Before I added Auto Calculation control to UpdatePriceData(), I was stunned by how slow the updates were going; that is what led to my adding the Status bar update text. Once I realized that Excel was recalculating all of that data after every cell assignment in the loop (which was not a problem when a single click on Excel's Refresh All toolbar button fetched everything at once), I added the ability to suspend recalculation. With auto recalc suspended, this method is as fast (or faster) than the original workbook with the web query.

History

6^th March, 2014: Initial version posted

Tested on a clean install of Excel 2016 (installed from DVD, not as part of O365). To my surprise, it worked fine without modification.