Query Online Database

[PC_User]

I'm developing code to download Yahoo stock quotes into MS Access 2K. I have
two public functions in a module. One that creates a temporary table and the
other fills it with data from Yahoo. Actually, it's suppose to do that when
I get it to work. All the Yahoo datafiles are listed on
http://datatables.org/alltables.env and I'm wondering if I can query them
like a table on any other remote server. There are a list of parameters that
the URL must have to select each field; so I've tried to include that in this
sample code. Below my code are a list of websites that I've been using to
develop this code. My question is how can I use the Yahoo data parameters to
insert their data into the temporary table.
**********************************************************************
Option Compare Database
Option Explicit

'Parameters for queries
Dim strSelect As String, strFrom As String
Dim strJoin As String, strWhere As String
Dim strOrderBy As String, strSQL As String
'Parameters for recordset
Dim db As DAO.Database, tblDef As DAO.TableDef
Dim rst1 As DAO.Recordset, rst2 As DAO.Recordset, rst3 As DAO.Recordset
Dim intRecCount1 As Integer, intRecCount2 As Integer
Dim i As Integer, j As Integer
' Flat file coversion

Public Function MakeQuoteTable() ' Make a new temporary table
"tmpYahooDownload"
On Error GoTo Whoops
Dim sTable As String
sTable = "tmpYahooDownload"
DBEngine(0)(0).TableDefs.Delete sTable

Dim db As Database
Dim tblDef As TableDef
Set db = CurrentDb()
Set tblDef = db.CreateTableDef(sTable)

With tblDef

'Ask,AverageDailyVolume,Bid,AskRealtime,BidRealtime,BookValue,
Change&PercentChange,Change,Commission,
.Fields.Append .CreateField("Ask", dbText)
.Fields.Append .CreateField("AverageDailyVolume", dbText)
.Fields.Append .CreateField("Bid", dbText)
.Fields.Append .CreateField("AskRealtime", dbText)
.Fields.Append .CreateField("BidRealtime", dbText)
.Fields.Append .CreateField("BookValue", dbText)
.Fields.Append .CreateField("Change&PercentChange", dbText)
.Fields.Append .CreateField("Change", dbText)
.Fields.Append .CreateField("Commission", dbText)
End With
db.TableDefs.Append tblDef

Call InsertQuoteData

OffRamp:
Exit Function
Whoops:
MsgBox "Error #" & Err & ": " & Err.Description
Resume OffRamp

End Function

' ==================================================================

Public Function InsertQuoteData() ' Insert data into "twmFields"
Dim DataURL As String
Dim db As Database
Dim sTable As String

Dim strSymbol As String, QuoteSource As String
Dim frmCurrentForm As Form
Set frmCurrentForm = Screen.ActiveForm

sTable = "tmpYahooDownload"
strSymbol = frmCurrentForm.Symbol

DataURL = "http://download.finance.yahoo.com/d/quotes.csv?" & _
"f=aa2bb2b3b4cc1c3" & _
"&s=" & strSymbol

QuoteSource = "http://ichart.finance.yahoo.com/table.csv?"
'Insert data into temporary table.
Set db = CurrentDb()

Set rst1 = db.OpenRecordset(sTable, dbOpenDynaset) 'Target
Set rst2 = db.OpenRecordset(QuoteSource) 'Source

rst2.MoveFirst
Do Until rst2.EOF

With rst1
.AddNew

'Ask,AverageDailyVolume,Bid,AskRealtime,BidRealtime,BookValue,
Change&PercentChange,Change,Commission,
![Ask] = rst2!a
![AverageDailyVolume] = rst2!a2
![Bid] = rst2!b
![AskRealtime] = rst2!b2
![BidRealtime] = rst2!b3
![BookValue] = rst2!b4
![Change&PercentChange] = rst2!c
![Change] = rst2!c1
![Commission] = rst2!c3

.Update
End With

rst2.MoveNext
Loop

rst1.MoveLast
rst1.MoveFirst
intRecCount1 = rst1.RecordCount
Debug.Print "intRecCount1 = " & intRecCount1
rst2.MoveLast
rst2.MoveFirst
intRecCount2 = rst2.RecordCount
Debug.Print "intRecCount2 = " & intRecCount2

rst2.Close
Set rst2 = Nothing
rst1.Close
Set rst1 = Nothing
db.Close
Set db = Nothing

End Function
**********************************************************************
Thanks,
PC

REFERENCES:
Dirk Eddelbuettel Finance
http://dirk.eddelbuettel.com/code/yahooquote.html
Downloading Yahoo Stock Quotes
http://www.spreadsheetml.com/finance/freed...ockquotes.shtml
Yahoo Data Download
http://www.gummy-stuff.org/Yahoo-data.htm
Yahoo! Query Language
http://developer.yahoo.com/yql/
Example
http://www.yqlblog.net/blog/2009/06/02/get...en-data-tables/
Yahoo! Developer Network
http://developer.yahoo.com/

 

[Alex Dybenko]

Hi,
you can use following approach to get data from web services:
http://accessblog.net/2006/12/how-to-retrieve-data-from-web-server.html

you have to modify sUrlRequest, like this for example:
sUrlRequest = "http://xoap.weather.com/search/search?where=98004"


--
Best regards,
___________
Alex Dybenko (MVP)
http://accessblog.net
http://www.PointLtd.com

I'm developing code to download Yahoo stock quotes into MS Access 2K. I
have
two public functions in a module. One that creates a temporary table and
the
other fills it with data from Yahoo. Actually, it's suppose to do that
when
I get it to work. All the Yahoo datafiles are listed on
http://datatables.org/alltables.env and I'm wondering if I can query them
like a table on any other remote server. There are a list of parameters
that
the URL must have to select each field; so I've tried to include that in
this
sample code. Below my code are a list of websites that I've been using to
develop this code. My question is how can I use the Yahoo data parameters
to
insert their data into the temporary table.
**********************************************************************
Option Compare Database
Option Explicit

'Parameters for queries
Dim strSelect As String, strFrom As String
Dim strJoin As String, strWhere As String
Dim strOrderBy As String, strSQL As String
'Parameters for recordset
Dim db As DAO.Database, tblDef As DAO.TableDef
Dim rst1 As DAO.Recordset, rst2 As DAO.Recordset, rst3 As DAO.Recordset
Dim intRecCount1 As Integer, intRecCount2 As Integer
Dim i As Integer, j As Integer
' Flat file coversion

Public Function MakeQuoteTable() ' Make a new temporary table
"tmpYahooDownload"
On Error GoTo Whoops
Dim sTable As String
sTable = "tmpYahooDownload"
DBEngine(0)(0).TableDefs.Delete sTable

Dim db As Database
Dim tblDef As TableDef
Set db = CurrentDb()
Set tblDef = db.CreateTableDef(sTable)

With tblDef

'Ask,AverageDailyVolume,Bid,AskRealtime,BidRealtime,BookValue,
Change&PercentChange,Change,Commission,
.Fields.Append .CreateField("Ask", dbText)
.Fields.Append .CreateField("AverageDailyVolume", dbText)
.Fields.Append .CreateField("Bid", dbText)
.Fields.Append .CreateField("AskRealtime", dbText)
.Fields.Append .CreateField("BidRealtime", dbText)
.Fields.Append .CreateField("BookValue", dbText)
.Fields.Append .CreateField("Change&PercentChange", dbText)
.Fields.Append .CreateField("Change", dbText)
.Fields.Append .CreateField("Commission", dbText)
End With
db.TableDefs.Append tblDef

Call InsertQuoteData

OffRamp:
Exit Function
Whoops:
MsgBox "Error #" & Err & ": " & Err.Description
Resume OffRamp

End Function

' ==================================================================

Public Function InsertQuoteData() ' Insert data into "twmFields"
Dim DataURL As String
Dim db As Database
Dim sTable As String

Dim strSymbol As String, QuoteSource As String
Dim frmCurrentForm As Form
Set frmCurrentForm = Screen.ActiveForm

sTable = "tmpYahooDownload"
strSymbol = frmCurrentForm.Symbol

DataURL = "http://download.finance.yahoo.com/d/quotes.csv?" & _
"f=aa2bb2b3b4cc1c3" & _
"&s=" & strSymbol

QuoteSource = "http://ichart.finance.yahoo.com/table.csv?"
'Insert data into temporary table.
Set db = CurrentDb()

Set rst1 = db.OpenRecordset(sTable, dbOpenDynaset) 'Target
Set rst2 = db.OpenRecordset(QuoteSource) 'Source

rst2.MoveFirst
Do Until rst2.EOF

With rst1
.AddNew

'Ask,AverageDailyVolume,Bid,AskRealtime,BidRealtime,BookValue,
Change&PercentChange,Change,Commission,
![Ask] = rst2!a
![AverageDailyVolume] = rst2!a2
![Bid] = rst2!b
![AskRealtime] = rst2!b2
![BidRealtime] = rst2!b3
![BookValue] = rst2!b4
![Change&PercentChange] = rst2!c
![Change] = rst2!c1
![Commission] = rst2!c3

.Update
End With

rst2.MoveNext
Loop

rst1.MoveLast
rst1.MoveFirst
intRecCount1 = rst1.RecordCount
Debug.Print "intRecCount1 = " & intRecCount1
rst2.MoveLast
rst2.MoveFirst
intRecCount2 = rst2.RecordCount
Debug.Print "intRecCount2 = " & intRecCount2

rst2.Close
Set rst2 = Nothing
rst1.Close
Set rst1 = Nothing
db.Close
Set db = Nothing

End Function
**********************************************************************
Thanks,
PC

REFERENCES:
Dirk Eddelbuettel Finance
http://dirk.eddelbuettel.com/code/yahooquote.html
Downloading Yahoo Stock Quotes
http://www.spreadsheetml.com/finance/freed...ockquotes.shtml
Yahoo Data Download
http://www.gummy-stuff.org/Yahoo-data.htm
Yahoo! Query Language
http://developer.yahoo.com/yql/
Example
http://www.yqlblog.net/blog/2009/06/02/get...en-data-tables/
Yahoo! Developer Network
http://developer.yahoo.com/

 

[PC_User via AccessMonster.com]

Hi Alex Dybenko,

Thank you for your reply. Your code looks similar to code that I
found at dBforums shown by Matthew Reeves at
http://www.dbforums.com/microsoft-access/1618879-how-query-download-directly-yahoo-finance.html
This code works very well when the only parameters are the beginning and
ending dates for a range of data. However, the Yahoo URL I show includes a
formatting parameter to download financial parameters other than dates. In
order to insert data from the Yahoo table fields into my Access database
fields, I need to use recordsets to insert one field from one field.

The URL formatting parameters are listed on the reference websites
that I show in my posting and are too many to list here. Each parameter
takes one field from the Yahoo database (i.e. OpeningPrice, ClosingPrice, etc.
) I'm not sure how your code can do this, because I've tried this with
Mathew's code. If you see some way to modify your code to do this, please
let me know.

Thanks,
PC

 

[PC_User via AccessMonster.com]

Alex,

I looked at your code again to verify the parameters used for the dates.
The confusion in these are that they are used as date parameters in your code
and according to YQL (Yahoo Query Language) they are as follows:

a = Ask
b = Bid
c = Change & Percent Change
d = Dividend/Share
e = Earnings/Share
f = URL formatting codes
g = Day's Low

This is why I'm having trouble reconciling the two versions of the same YQL.

Thanks,
PC

 

[PC_User via AccessMonster.com]

According to the YQL instructions, I should be able to query the quotes table
directly. http://www.devx.com/webdev/Article/40432
===============================================
Public Function InsertQuoteData() ' Insert data into "strTable"
Dim DataURL As String
Dim db As Database
Dim strTable As String

Dim strSymbol As String, QuoteSource As String
Dim frmCurrentForm As Form
Set frmCurrentForm = Screen.ActiveForm

strTable = "tmpYahooQuotes"
strSymbol = frmCurrentForm.Symbol

DataURL = "
http://www.datatables.org/yahoo/finance/yahoo.finance.quotes.xml"

strSelect = "SELECT DataURL.* "
strFrom = "FROM DataURL "
strWhere = "WHERE DataURL.Symbol = strSymbol and DataURL.Columns = " & _
"[Symbol], [LastTradePriceOnly], [LastTradeDate], [LastTradeTime],
[Change], [Open], [DaysHigh], [DaysLow], [Volume]"

strSQL = strSelect & strFrom & strWhere

'Insert data into temporary table.
Set db = CurrentDb()

Set rst1 = db.OpenRecordset(strTable, dbOpenDynaset) 'Target
Set rst2 = db.OpenRecordset(strSQL) 'Source

rst2.MoveFirst
Do Until rst2.EOF

With rst1
.AddNew

![Symbol] = rst2!Symbol
![LastTradePriceOnly] = rst2!LastTradePriceOnly
![LastTradeDate] = rst2!LastTradeDate
![LastTradeTime] = rst2!LastTradeTime
![Change] = rst2!Change
![Open] = rst2!Open
![DaysHigh] = rst2!DaysHigh
![DaysLow] = rst2!DaysLow
![Volume] = rst2!Volume

.Update
End With

rst2.MoveNext
Loop

rst2.Close
Set rst2 = Nothing
rst1.Close
Set rst1 = Nothing
db.Close
Set db = Nothing

End Function
===============================================
Anyone see an error in this code?

Thanks,
PC

 

[Alex Dybenko]

Hi,
I think Matthew code is what you need, although it used the same library as
mine, you just need to build right sHttp, like
http://download.finance.yahoo.com/d/quotes.csv?s=MSFT
try different parameters to make sure you get proper XML - then you can use
my or matthew code to put data into table

--
Best regards,
___________
Alex Dybenko (MVP)
http://accessblog.net
http://www.PointLtd.com

 

[PC_User via AccessMonster.com]

Thank you for your help, Alex. I like your website. I think you'll like
this code.
This code is from a posting by Albert D. Kallal - 18 Nov 2009 17:05 and it
seems to do what I need it to do.
http://www.accessmonster.com/Uwe/Forum.aspx/access/123670/SOAP-Call-from-VBA
========================================================
Public Function GetQuote()
On Error GoTo Whoops

Dim objXML As Object
Dim strSymbol As String
Dim strURL As String
Dim strWFormat As String

Set objXML = CreateObject("MSXML2.XMLHTTP")

strURL = "http://download.finance.yahoo.com/d/quotes.csv?s="
strWFormat = "&f=sl1d1t1c1ohgv&e=.csv"

' For maximum info download use this format code and re-define the Debug
statement. See YQL format definitions.
'strWFormat =
"&f=aa2bb2b3b4cc1c3c6c8dd1d2ee1e7e8e9ghjkg1g3g4g5g6ii5j1j3j4j5j6k1k2k4k5ll1l2l3mm2m3m4m5m6m7m8nn4opp1p2p5p6qrr1r2r5r6r7ss1s7t1t7t8vv1v7ww1w4xy&e=.
csv"

strSymbol = "MSFT"

objXML.Open "GET", strURL & strSymbol & strWFormat, False
objXML.send

Debug.Print "Symbol = " & Split(objXML.responseText, ",")(0)
Debug.Print "Trade = " & Split(objXML.responseText, ",")(1)
Debug.Print "Date = " & Split(objXML.responseText, ",")(2)

OffRamp:
Exit Function
Whoops:
MsgBox "Error #" & Err & ": " & Err.Description
Resume OffRamp

End Function
========================================================
I still have more work to do on this, but the really hard part is solved by
this code. Now I need to import the data from the external csv file into
Access and then I can use the data.
------------------------------------------------------------------------------
----------------------------------
To understand the YQL formatting code see the reference websites in this
posting.
Another YQL reference website:
http://code.google.com/p/yahoo-finance-managed/wiki/csvQuotesDownload

Regards,
PC User

 

[PC_User via AccessMonster.com]

Ok Alex. This works and there is no need for a temporary csv file. The
fields insert directly into the Access table from the website. Thanks again
for your moral support.
==================================================================
Public Function GetQuote()
On Error GoTo Whoops

Dim strSymbol As String
Dim strURL As String
Dim strWFormat As String
Dim strTable As String
Dim objXML As Object
Dim td As DAO.TableDef
Dim ff As Integer
Dim byteData() As Byte
Dim db As DAO.Database
Dim tblDef As DAO.TableDef
Dim rst As DAO.Recordset

strTable = "tmpYahooQuotes"
strSymbol = "IMAX"
strURL = "http://download.finance.yahoo.com/d/quotes.csv?s="
strWFormat = "&f=snl1d1t1x&e=.csv"

Set objXML = CreateObject("MSXML2.XMLHTTP")

' For maximum info download use this format code and arrange parameters
to match table content.
'strWFormat =
"&f=aa2bb2b3b4cc1c3c6c8dd1d2ee1e7e8e9ghjkg1g3g4g5g6ii5j1j3j4j5j6k1k2k4k5ll1l2l3mm2m3m4m5m6m7m8nn4opp1p2p5p6qrr1r2r5r6r7ss1s7t1t7t8vv1v7ww1w4xy&e=.
csv"

objXML.Open "GET", strURL & strSymbol & strWFormat, False
objXML.send

Debug.Print "Symbol = " & Split(objXML.responseText, ",")(0)
Debug.Print "Company Name = " & Split(objXML.responseText, ",")(1)
Debug.Print "Last Trade Price = " & Split(objXML.responseText, ",")(2)
Debug.Print "Last Trade Date = " & Split(objXML.responseText, ",")(3)
Debug.Print "Last Trade Time = " & Split(objXML.responseText, ",")(4)
Debug.Print "Stock Exchange = " & Split(objXML.responseText, ",")(5)

Set db = CurrentDb()
Set tblDef = db.CreateTableDef(strTable)
With tblDef
.Fields.Append .CreateField("Symbol", dbText)
.Fields.Append .CreateField("CompanyName", dbText)
.Fields.Append .CreateField("LastTradePrice", dbText)
.Fields.Append .CreateField("LastTradeDate", dbText)
.Fields.Append .CreateField("LastTradeTime", dbText)
.Fields.Append .CreateField("StockExchange", dbText)
End With

db.TableDefs.Append tblDef

Set rst = db.OpenRecordset(strTable, dbOpenDynaset) 'Target

With rst
.AddNew

![Symbol] = Split(objXML.responseText, ",")(0)
![CompanyName] = Split(objXML.responseText, ",")(1)
![LastTradePrice] = Split(objXML.responseText, ",")(2)
![LastTradeDate] = Split(objXML.responseText, ",")(3)
![LastTradeTime] = Split(objXML.responseText, ",")(4)
![StockExchange] = Split(objXML.responseText, ",")(5)

.Update
End With

rst.Close
Set rst = Nothing
db.Close
Set db = Nothing

OffRamp:
Exit Function
Whoops:
MsgBox "Error #" & Err & ": " & Err.Description
Resume OffRamp

End Function
==================================================================

Regards,
PC User

 

[Alex Dybenko]

ok, great, glad that you found solution!

--
Best regards,
___________
Alex Dybenko (MVP)
http://accessblog.net
http://www.PointLtd.com

Ok Alex. This works and there is no need for a temporary csv file. The
fields insert directly into the Access table from the website. Thanks
again
for your moral support.
==================================================================
Public Function GetQuote()
On Error GoTo Whoops

Dim strSymbol As String
Dim strURL As String
Dim strWFormat As String
Dim strTable As String
Dim objXML As Object
Dim td As DAO.TableDef
Dim ff As Integer
Dim byteData() As Byte
Dim db As DAO.Database
Dim tblDef As DAO.TableDef
Dim rst As DAO.Recordset

strTable = "tmpYahooQuotes"
strSymbol = "IMAX"
strURL = "http://download.finance.yahoo.com/d/quotes.csv?s="
strWFormat = "&f=snl1d1t1x&e=.csv"

Set objXML = CreateObject("MSXML2.XMLHTTP")

' For maximum info download use this format code and arrange parameters
to match table content.
'strWFormat =
"&f=aa2bb2b3b4cc1c3c6c8dd1d2ee1e7e8e9ghjkg1g3g4g5g6ii5j1j3j4j5j6k1k2k4k5ll1l2l3mm2m3m4m5m6m7m8nn4opp1p2p5p6qrr1r2r5r6r7ss1s7t1t7t8vv1v7ww1w4xy&e=.
csv"

objXML.Open "GET", strURL & strSymbol & strWFormat, False
objXML.send

Debug.Print "Symbol = " & Split(objXML.responseText, ",")(0)
Debug.Print "Company Name = " & Split(objXML.responseText, ",")(1)
Debug.Print "Last Trade Price = " & Split(objXML.responseText, ",")(2)
Debug.Print "Last Trade Date = " & Split(objXML.responseText, ",")(3)
Debug.Print "Last Trade Time = " & Split(objXML.responseText, ",")(4)
Debug.Print "Stock Exchange = " & Split(objXML.responseText, ",")(5)

Set db = CurrentDb()
Set tblDef = db.CreateTableDef(strTable)
With tblDef
.Fields.Append .CreateField("Symbol", dbText)
.Fields.Append .CreateField("CompanyName", dbText)
.Fields.Append .CreateField("LastTradePrice", dbText)
.Fields.Append .CreateField("LastTradeDate", dbText)
.Fields.Append .CreateField("LastTradeTime", dbText)
.Fields.Append .CreateField("StockExchange", dbText)
End With

db.TableDefs.Append tblDef

Set rst = db.OpenRecordset(strTable, dbOpenDynaset) 'Target

With rst
.AddNew

![Symbol] = Split(objXML.responseText, ",")(0)
![CompanyName] = Split(objXML.responseText, ",")(1)
![LastTradePrice] = Split(objXML.responseText, ",")(2)
![LastTradeDate] = Split(objXML.responseText, ",")(3)
![LastTradeTime] = Split(objXML.responseText, ",")(4)
![StockExchange] = Split(objXML.responseText, ",")(5)

.Update
End With

rst.Close
Set rst = Nothing
db.Close
Set db = Nothing

OffRamp:
Exit Function
Whoops:
MsgBox "Error #" & Err & ": " & Err.Description
Resume OffRamp

End Function
==================================================================

Regards,
PC User

 

[PC_User via AccessMonster.com]

It appears that Google also provides stock quotes. How to get a real-time
stock quote using Google API
http://yken.org/2009/01/05/how-to-get-a-real-time-stock-quote-using-google-api/
and there is some hint that it might be realtime quotes. Realtime is good.
Has anyone tried the Google Quote script in MS Access? It looks different
from the Yahoo Quote script.

Google Finance APIs and Tools
http://code.google.com/apis/finance/docs/2.0/reference.html#Feeds

 

[PC_User via AccessMonster.com]

Historical Quotes - Google Finance
http://www.etraderzone.com/free-scripts/49-historical-quotes-google-finance.html

Google Quotes Excel Spreadsheet:
http://www.etraderzone.com/scripts/historical-google.zip

 

[PC_User via AccessMonster.com]

This is the VB code from the Excel Spreadsheet.
===============================================================
Public fname, fn, DIYSub_Dir, SD, SM, SY, SY_2
Sub Download()

Set occXMLHTTP = CreateObject("Microsoft.XMLHTTP")
Set fso = CreateObject("Scripting.FileSystemObject")

DIY_Dir = "c:\eTraderZone\"
DIYSub_Dir = "c:\eTraderZone\tickers\"

If Not fso.FolderExists(DIY_Dir) Then
MkDir DIY_Dir
End If

If Not fso.FolderExists(DIYSub_Dir) Then
MkDir DIYSub_Dir
End If

Check_Date
PFROW = 1

Do Until Worksheets("Portfolio").Cells(PFROW, 1) = ""
PFROW = PFROW + 1
Loop

PFROW = PFROW - 1

For x = 1 To PFROW
fn = Worksheets("Portfolio").Cells(x, 1)
fname = Worksheets("Portfolio").Cells(x, 1) & ".txt"
occXLS = DIYSub_Dir & fname
occUrl = "http://finance.google.com/finance/historical?q=" & Trim
(Worksheets("Portfolio").Cells(x, 1)) & _
"&startdate=" & SM & "+" & SD & "+" & SY & "&enddate=" & SM & "+" & SD &
"+" & SY_2 & "&output=csv"
occLocalFile = DIYSub_Dir & fname
occLocalFileName = Worksheets("Portfolio").Cells(x, 1) & ".txt"

occXMLHTTP.Open "GET", occUrl, False
occXMLHTTP.send
occArray = occXMLHTTP.ResponseBody
occfile = 1

Open occLocalFile For Binary As #occfile
Put #occfile, , occArray
Close #occfile

RemoveLine
Next

Response = MsgBox _
("Download Completed." & vbCrLf & _
"Open C:\eTraderZone\Tickers to view files ?", vbYesNo)

If Response = vbYes Then
RetVal = Shell("explorer " & DIYSub_Dir, 1)
End If

End Sub
===============================================================