asked on

Download Yahoo stock quotes into MS Access

Does anyone have an Access DB that will download stock quotes? I have been using one for many years but it stopped working recently. When I do the download, I receive "Error #9: Subscript out of range". I receive the identical error using back-up copies of the DB on other computers.
If someone has the basic download part, I can adapt it for my purposes. Or, if someone can suggest a solution to the problem I have encountered, that might work, also.

Lee W, MVP

I used to use a Function in Excel to get Yahoo stock prices but I want to say about 6 months ago, they must have changed something. I re-wrote it using cnbc - code below. It's slow though. Not sure if it's my coding, their website, or what. There are a few others I tried, some of them commented out in the code below.

Function StockQuote(Ticker)

    ' Compile the request URL with start date and end date
    'Yahoo
    'URL = "http://ichart.finance.yahoo.com/table.csv?s=" & Ticker & "&a=" & Month(StartDate) & "&b=" & Day(StartDate) & "&c=" & Year(StartDate)
    'URL = URL & "&d=" & Month(EndDate) & "&e=" & Day(EndDate) & "&f=" & Year(EndDate) & "&g=d&ignore=.csv"
    
    'URL = "http://money.cnn.com/quote/quote.html?symb=" & Ticker   'Works, but parsing is a nightmare
    'URL = "http://www.nasdaq.com/aspx/flashquotes.aspx?symbol=" & Ticker & "&selected=" & Ticker       'COSTlastsale
    Url = "http://www.cnbc.com/quotes/" & Ticker       'var quoteDataObj
    
    Set HTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    HTTP.Open "GET", Url, False
    HTTP.Send
    CSV = HTTP.ResponseText

    DataRows = Split(CSV, Chr(10)) ' split the CSV into rows
    ExitRowFor = False
    For RowNumber = LBound(DataRows) To UBound(DataRows)
        If InStr(DataRows(RowNumber), "symbolInfo") Then
            Quote = DataRows(RowNumber)
            Quote = Right(Quote, Len(Quote) - InStr(Quote, "{"))
            Params = Split(Quote, """,""")
            For Param = LBound(Params) To UBound(Params)
                If InStr(Params(Param), "last"":""") Then
                    RawQuote = Params(Param)
                    Exit For
                    ExitRowFor = True
                End If
            Next
            If ExitRowFor = True Then Exit For
        End If
    Next
    StockQuote = Replace(RawQuote, "last"":""", "")
  

End Function

Open in new window

bfuchs

This guy faced a similar issue, see if that solution helps..

https://www.experts-exchange.com/questions/29067028/Automatically-get-latest-currency-exchange-rates-into-Access-97.html?notificationFollowed=199943659&anchorAnswerId=42358770#a42358770

This question needs an answer!

Become an EE member today

7 DAY FREE TRIAL

Members can start a 7-Day Free trial then enjoy unlimited access to the platform.

View membership options

Learn why we charge membership fees

We get it - no one likes a content blocker. Take one extra minute and find out why we block content.