<%dim crumb crumb="Download Stock Quotes" Crumb2="Stock Quotes Access" crumb1="Visual Basic Stock Quote" %> VBA Stock Quotes
Home  Fees/Services  Access 2010 Template  Access Tutorial  Access Download  Articles  Search  Contact  Privacy  Links

<%if len(crumb2)>2 then response.write crumb2 else response.write ">
<% response.write crumb1 %>

Visual Basic Tutorials:
Access-Google Earth
Age Calculation
Change To Proper Case
Email via Gmail #1
Send Gmail Email #2
Inactivity Logout Code
Outlook Email
Read Email Access
Email Attachment
Send Outlook Email
Running Sum
Denormalize Records
Stock Quotes
Find Database Path
Detail-Master Update
Data Field Validation
Field Value New-Old
Access Version
Global Variable Parameter
Global Variables
Active Labels
Files List Box
Mail Merge
Quick Sort
Recordset Filters
Reference Form Field
Select Case
Access Transactions

Visual Basic Function Examples

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.

Around the last week of April, 2015 the Yahoo Finance API stopped working.  After much research it seems the broken API was cause by a slight change in the options of the command line.  The old broken API interface line starts like this:
The new fixed line looks like this:

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.

How To Get Stock Quote Within Excel

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")

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

    MsgBox Error$ & " MailIt "

GoTo Exit_MailIt     Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
    XMLHTTP.Open "GET", shttp, False
    result = XMLHTTP.responseText

Here is a more simple stock quote function from our Query Design Yahoo API example.
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
        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
        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
        rst!PriceDate = Rdate
        rst![security name] = Rdescr
        rst!Price = Rprice
        rst!Indicated_Div = Rdiv
        rst!Yield_ttm = Ryld
        rst!Av_Volume = Rvol

    End With
Set rst = Nothing
MsgBox "Done."

End Sub

Here is a complete list of all the attribute options:
a Ask a2 Average Daily Volume a5 Ask Size
b Bid b2 Ask (Real-time) b3 Bid (Real-time)
b4 Book Value b6 Bid Size c Change & Percent Change
c1 Change c3 Commission c6 Change (Real-time)
c8 After Hours Change (Real-time) d Dividend/Share d1 Last Trade Date
d2 Trade Date e Earnings/Share e1 Error Indication (returned for symbol changed / invalid)
e7 EPS Estimate Current Year e8 EPS Estimate Next Year e9 EPS Estimate Next Quarter
f6 Float Shares g Day's Low h Day's High
j 52-week Low k 52-week High g1 Holdings Gain Percent
g3 Annualized Gain g4 Holdings Gain g5 Holdings Gain Percent (Real-time)
g6 Holdings Gain (Real-time) i More Info i5 Order Book (Real-time)
j1 Market Capitalization j3 Market Cap (Real-time) j4 EBITDA
j5 Change From 52-week Low j6 Percent Change From 52-week Low k1 Last Trade (Real-time) With Time
k2 Change Percent (Real-time) k3 Last Trade Size k4 Change From 52-week High
k5 Percebt Change From 52-week High l Last Trade (With Time) l1 Last Trade (Price Only)
l2 High Limit l3 Low Limit m Day's Range
m2 Day's Range (Real-time) m3 50-day Moving Average m4 200-day Moving Average
m5 Change From 200-day Moving Average m6 Percent Change From 200-day Moving Average m7 Change From 50-day Moving Average
m8 Percent Change From 50-day Moving Average n Name n4 Notes
o Open p Previous Close p1 Price Paid
p2 Change in Percent p5 Price/Sales p6 Price/Book
q Ex-Dividend Date r P/E Ratio r1 Dividend Pay Date
r2 P/E Ratio (Real-time) r5 PEG Ratio r6 Price/EPS Estimate Current Year
r7 Price/EPS Estimate Next Year s Symbol s1 Shares Owned
s7 Short Ratio t1 Last Trade Time t6 Trade Links
t7 Ticker Trend t8 1 yr Target Price v Volume
v1 Holdings Value v7 Holdings Value (Real-time) w 52-week Range
w1 Day's Value Change w4 Day's Value Change (Real-time) x Stock Exchange
y Dividend        

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.


Below are a bunch of different financial functions for various stock data from my Excel Spreadsheet VBA Code.

Function buyyld(div, buyprice)

' ---figure out current yield
buyyld = div / buyprice
End Function
Function CurYld(div, share) As Variant
CurYld = div / share
End Function
Function DivAmtQ(div, shares)

' ---get dividend amount
DivAmtQ = div * shares
End Function
Function DivQ(annualdiv) As Variant
'MsgBox annualdiv
On Error GoTo endit
If annualdiv = "N/A" Then Exit Function

DivQ = annualdiv / 4
Exit Function
DivQ = Null
End Function

Function FromAvg200(strticker As String) As Variant

'-----retrieve 200 day moving average
Dim strurl As String
Dim strcsv As String
strurl = "http://download.finance.yahoo.com/d/quotes.csv/q?s=" & strticker & "&f=m5&ignore=.csv"
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", strurl, False
strcsv = http.responseText
FromAvg200 = Left(strcsv, 5)
Set http = Nothing
End Function
Function FromAvg50(strticker As String) As Variant

'--- retrieve 50 day moving average
Dim strurl As String
Dim strcsv As String
strurl = "http://download.finance.yahoo.com/d/quotes.csv/q?s=" & strticker & "&f=m8&ignore=.csv"
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", strurl, False
strcsv = http.responseText

FromAvg50 = Left(strcsv, 5)
Set http = Nothing
End Function
Function DivAmt(strticker As String) As Variant

'--- retrieve quarterly dividend amount
strurl = "http://download.finance.yahoo.com/d/quotes.csv/q?s=" & strticker & "&f=d&ignore=.csv"

Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", strurl, False
strcsv = http.responseText
'MsgBox strURL & strTicker & strCSV

DivAmt = strcsv
Set http = Nothing
End Function
Function StockQuote(strticker As String, Optional dtDate As Variant)

'--- get stock quote
Application.Volatile True
' Date is optional - if omitted, use today. If value is not a date, throw error.
If IsMissing(dtDate) Then
dtDate = Date
If Not (IsDate(dtDate)) Then
StockQuote = CVErr(xlErrNum)
End If
End If

Dim dtPrevDate As Date
Dim strurl As String, strcsv As String, strRows() As String, strColumns() As String
Dim dbClose As Double

dtPrevDate = dtDate - 7

strurl = "http://download.finance.yahoo.com/d/quotes.csv/q?s=" & strticker & "&f=l1&ignore=.csv"

Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", strurl, False
strcsv = http.responseText
'MsgBox strCSV

StockQuote = CCur(strcsv)
Set http = Nothing

End Function

We have a downloadable example of a simple function to get stock quotes using Yahoo Finance's API.  Checkout our new Form API Interface Database.


Microsoft Office:
MS Access 2000 Through 2016 and Office 365 & Sharepoint

Contact Information

<% Response.write "Copyright 2000-" & year(now) & " Blue Claw Database Design" %>

Microsoft Access 2007, 2010, 2013 & 2016