Stock Quote VB Yahoo API

Stock quote downloads in to Microsoft Access took a surprisingly long time to figure out.  I thought it would be simple to create the VBA code to talk to Yahoo Finance and load stock quotes into my Access tables. Most of the examples where for PHP, C++ or Excel and where difficult to get running just right.

In addition to current share price information you may download a long list of other stock attributes such as yield, last trade, day's low, day's high and more.  This API will work for stocks, bonds, mutual funds, ETFs and most any equity with a valid symbol.

Below is the VBA code programmed to download Yahoo Finance stock quotes into my database table.

Private Sub Command1_Click()
Dim rst As DAO.Recordset
Dim db As DAO.Database
Dim result As Variant
Dim XMLHTTP As Object
Dim Rdate As Date
Dim Rsymbol As String
Dim Rdescr As String
Dim Rprice As Double
Dim Rdiv As Double
Dim Ryld As Double
Dim Rvol As Long
Dim ipos1 As Long
Dim ipos2 As Long
Dim ipos3 As Long
Dim shttp As String
' let us begin
Set db = CurrentDb
Set rst = db.OpenRecordset("Select * from M_Security where auto_price=true")
rst.MoveFirst

Do While Not rst.EOF

    ' in the line below &f=d1nsl1dya2 this is the part that tells yahoo what type
    ' of data to download and the various attributes you want to retrieve.
    ' the options chosen are:

     ' d1= Last Trade Date
    ' n= Equity Name
    ' s= symbol
    ' l= last trade (share price)
    ' d=dividend share
    ' y=dividend yield
    ' a2=average daily volume
    '
    ' see end of example for link to complete list of attributes

    shttp = "http://download.finance.yahoo.com/d/quotes.csv/q?s=" & _
    rst![Security Symbol] & "&f=d1nsl1dya2&ignore=.csv"

    ' the next 5 lines were the difficult part to get yahoo to send the quotes
    Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
    XMLHTTP.Open "GET", shttp, False
    XMLHTTP.send
    result = XMLHTTP.responseText
    Set XMLHTTP = Nothing

    ' parse result
    ' if no date then skip
    If Mid(result, 2, 3) = "N/A" Then
        GoTo skip_it
    End If
    ' parse csv string to extract data
    ' get quote date first
    ipos1 = InStr(result, Chr(34) & "," & Chr(34))
    Rdate = Mid(result, 2, 9)
    ' next get security name
    ipos2 = InStr(ipos1 + 2, result, Chr(34) & "," & Chr(34))
    Rdescr = Mid(result, ipos1 + 3, ipos2 - (ipos1 + 3))
    ' next is the security symbol
    ipos3 = InStr(ipos2 + 2, result, Chr(34) & ",")
    Rsymbol = Mid(result, ipos2 + 3, ipos3 - (ipos2 + 3))
    ' then the last stock price
    ipos1 = InStr(ipos3 + 2, result, ",")
    Rprice = Mid(result, ipos3 + 2, ipos1 - (ipos3 + 2))
    ' now the dividend
    ipos2 = InStr(ipos1 + 1, result, ",")
    If Mid(result, ipos1 + 1, ipos2 - (ipos1 + 1)) = "N/A" Then
        ' invalid dividend
        Rdiv = 0
    Else
        Rdiv = Mid(result, ipos1 + 1, ipos2 - (ipos1 + 1))
    End If
    ' then the dividend yield
    ipos3 = InStr(ipos2 + 1, result, ",")
    If Mid(result, ipos2 + 1, ipos3 - (ipos2 + 1)) = "N/A" Then
        ' bad yield value
        Ryld = 0
    Else
        Ryld = Mid(result, ipos2 + 1, ipos3 - (ipos2 + 1))
    End If
    ' last is the volume
    Rvol = Mid(result, ipos3 + 1, Len(result) - ipos3 + 1)
    ' now update the tables with the new quote data
    With rst
        .Edit
        rst!PriceDate = Rdate
        rst![security name] = Rdescr
        rst!Price = Rprice
        rst!Indicated_Div = Rdiv
        rst!Yield_ttm = Ryld
        rst!Av_Volume = Rvol
        .Update
    End With
skip_it:
    rst.MoveNext
Loop
rst.Close
Set rst = Nothing
MsgBox "Done."

End Sub

See a complete list of all the attribute options which can be downloaded from Yahoo visit this site:  Yahoo special tags

That was pretty simple after getting the code correct to make the yahoo finance website response to me in something other than binary data.  The CSV part of the call to yahoo finance was key to the solution.