一个基于Excel VBA和Google API的股票报价表格

:::[下载源文件]:::

一个企业发行股票放到市场让人们（股民）去买，目的就是筹集资金、拓展业务、赚更多的钱。这样做比问银行借好，要知道银行的借贷息率不低啊。

然而，股民买了股票之后，即使那个企业赚到了钱，也没有规定一定要分红、派息等等。所以说，上市集资对一家企业来讲，是多么划算的一件事！而且，万一倒闭了，那些股票就会变得一文不值，股民也不会得到任何赔偿。

问题是，为什么还有那么多股民啊？

普遍来说，上市企业是有一定的财政和管理基础的，所以倒闭的情况并不多见；反而，因为管理日益不善，或者行业整体萧条，而导致业务、财政出现问题的，则不少见。但是，也鲜见有倒闭的情况，至多是苟延残喘罢了。其实，很多上市企业是非常具有实力和潜力的，而且还会定期派发股息，多的会有7、8厘的年利率，这还是挺吸引的，所以有不少人支持。

买股票，很多人说这是投机，我同意；也有人说那是投资，我也同意。一件事物，如果我们从不同的角度去看，看出来的都会不一样，这很类似于一个处于叠加状态的系统......

噢，越扯越远了，不好意思！

在这篇文章里，我会介绍最近创作的一个小程序----一个基于Excel VBA和Google API的股票报价表格。

1. 股票报价表格的基本样式

下面（图一）是整个报价表的样式：最左边的是股票代号，然后是股票名称，接着是股价、股价变动。

只需要摁一下右上方的“Update Now”，程序就会自动更新股价信息，用户还可以知道更新的进度、日期和时间。除此以外，用户还可以随意增减股票代号的数目，记得保存修改就是了。



（图一）股票报价表格的样式和流程说明

2. Google Finance API

啊哈，讲到Google Finance API，这就是我们这个表单的核心。其实除了谷歌有提供财经相关的web API，雅虎也有它自己的财经API。两者的分别是，谷歌提供的资料格式比较简单（JSON格式），雅虎则比较详细（CSV格式）。虽然网上例子多是用雅虎的，但我觉得谷歌的更合适我这个应用。

使用Google Finance API：

(1) 用户发出HTTP GET request，例如：http://www.google.com.hk/finance/info?q=HKG:0005

(2) 谷歌服务器返回相对应的信息（如果查询不正确，譬如说股票代号不存在，返回的HTTP status code（状态代码）就不会是正常的200，而是表示Bad Request的400了）



（图二）用Google Finance API获取HKEx（香港联交所）股票编号为0005（汇丰银行）的延时股价信息：返回一个长度为1的JSON struct array



（图三）同时获取两个股票代号（0005和0066）的信息



（图四）获取美国NASDAQ（纳斯达克）代号为AAPL（苹果公司）的股票信息



（图五）查询港股代号为5的信息，返回staus=400的错误代码。 *_* why?!



（图六）查询港股代号为0005的信息，返回staus=200，OK



（图七）正常返回的完整股价信息格式（response text in JSON struct array）：留意空行、换行，还有前面的"//"

3. VBA编程

接下来，我将用Excel VBA把表格和Google的Finance API结合起来，这就是我们所说的技术了，哈哈。

首先，我得解决VBA本身不提供解析JSON资料格式的问题。虽然自己写一个不难，但是总比用现成的费劲儿。因此，我就找了一个开源的project:
vba-json，本人仅在此感谢相关的作者。



（图八）一个网上开源的VBA JSON类，用作解析及合成JSON data structure

解决了资料格式的问题，另外一个问题是：how to make such a request to Google？别忘了，VBA是很强大的，上网拿资料对它来讲嘛，简直就不算是什么问题，请看函数代码如下。

'Gets stock info for the corporate identified by the given stockCode listed in HKEx.
'Params
'   stockCode   :   stock code which identifies a listed corporate
'Return
'   a dictionary of (key,value)=(item_label, item_value).
Function GetStockInfo(stockCode As Integer) As Object

Set GetStockInfo = Nothing      'reset output as nothing

Dim httpReq As Object           'http request object

Dim jsonRespStr As String       'data in json format from http response

Dim jsonObjs As Object          'an array of json structs

Set httpReq = CreateObject("Microsoft.XMLHTTP")                 'create the http request object

With httpReq
Dim reqUrl                  'request url to google
reqUrl = "http://www.google.com.hk/finance/info?q=HKG:" & Format(stockCode, "0000")  'format the request link

.Open "GET", reqUrl, False  'set the request method and content
.Send (Null)                'send the request

'handle the server response
Select Case .Status
Case 200
jsonRespStr = Replace(.responseText, "//", "")      'get rid of the starting “//” characters in response text

Dim jsonlib As New jsonlib                          'create the jsonlib object for parsing the json data structs in string

Set jsonObjs = jsonlib.parse(CStr(jsonRespStr))     'parse and get the returning value which is in an array of json structs

'get the first json struct out of the array
For Each Item In jsonObjs
Set GetStockInfo = Item                         'assign to the returning value
Exit For
Next
Case Else
MsgBox "Error: RespStatus=" & CStr(.Status)         'show error msg for any other unexpected response code
End Select
End With

End Function

上面的函数GetStockInfo，是用来获取并返回股票代号的完整JSON struct信息。

接着这个函数GetSharePrice，会应用GetStockInfo提取并返回3项资料：(i)股票价格、(ii)价格变更、(iii)价格变更百分比。

'Gets the last updated share price of the listed company specified by the given stock code in HKEx.
'Params
'   stockCode   :   stock code which identifies a listed corporate
'Return
'   an array of double ordered as (price, price change, percentage price change).
Function GetSharePrice(stockCode As Integer) As Variant

Dim retArr(1 To 3) As Double                    'new an array of double[3]

Dim stockInfoDic As Object                      'stock info dictionary

Set stockInfoDic = GetStockInfo(stockCode)      'get the info of the given stock code

If stockInfoDic Is Nothing Then
MsgBox "Error: GetStockInfo=Nothing for stock code=" & CStr(stockCode)
Else
retArr(1) = CDbl(stockInfoDic("l"))         'get the price in HKD
retArr(2) = CDbl(stockInfoDic("c"))         'get the price change compared to last trading day
retArr(3) = CDbl(stockInfoDic("cp"))        'get the percentage price change compared to last trading day
End If

GetSharePrice = retArr                          'assign the array to returning value

End Function

有了以上两个函数作为动力，我们就可以轻易地对整个列表里的股票价格信息进行更新了！Excited？Let's go ahead！

'Updates the Quote List work sheet.
'Params
'   void
'Return
'   void
Function UpdateQuoteList()

Dim quoteListSheet As Object

Set quoteListSheet = Sheets("Quote List")

quoteListSheet.Cells(2, "J").value = Now                                'update the date time

Dim numOfRows As Integer                                                'total num of rows to update
Dim numOfUptRows As Integer                                             'total num of updated rows

numOfUptRows = 0                                                        'init num of updated rows as zero
numOfRows = quoteListSheet.UsedRange.Columns("B").Cells.Count           'get the total num of rows to update

'check if there is not any rows to update
If numOfRows = 0 Then
quoteListSheet.Cells(3, "J").value = 1                              'progress set as 1 (or 100%) if no rows to update
Return
End If

'update each row of share price and the change
For Each cell In quoteListSheet.UsedRange.Columns("B").Cells

'update only valid rows beginning from the 4th row
If cell.Row >= 4 Then

Dim priceCell As Object
Dim changeCell As Object
Dim pcChangeCell As Object

Set priceCell = quoteListSheet.Cells(cell.Row, "F")             'get the price cell
Set changeCell = quoteListSheet.Cells(cell.Row, "G")            'get the price change cell
Set pcChangeCell = quoteListSheet.Cells(cell.Row, "H")          'get the percentage price change cell

quoteListSheet.Rows(cell.Row).Interior.Color = vbYellow         'highlight the current row in yellow

Dim priceArr As Variant
priceArr = GetSharePrice(CInt(cell.value))                      'get the price array

priceCell.value = priceArr(1)
changeCell.value = priceArr(2)
pcChangeCell.value = priceArr(3)

quoteListSheet.Rows(cell.Row).Interior.ColorIndex = xlNone      'reset the row's background

numOfUptRows = numOfUptRows + 1                                 'update num of rows updated

quoteListSheet.Cells(3, "J").value = numOfUptRows / numOfRows   'update progress
Else
numOfRows = numOfRows - 1                                       'update num of rows to update
End If
Next
End Function

4. 完成作品效果演示

Let us have a look！



（图九）Yeah！股票报价正在更新中：76.92%



（图十）100%！已经完成更新整个表格的股票报价！

5. 总结

整个程序从设计规划，到实际的编程，只要向着根本的方向走，还有熟悉和灵活应用现有的资源，实行起来还是挺顺畅的。另外，这个程序的作用不单是作为报价，我们还可以运用强大的Excel功能，做一些统计、分析等等。一般的财经网站（譬如雅虎财经）都会提供很详细的股票资讯和一些简单的分析图表，可能你会觉得我做这个程序的意义不大。然而，如果我们要做一些自己定义的分析，网上的工具大多是爱莫能助的，那在这个情况下，我这个工具就显得比较灵活，或者更个性化，这样说比较恰当！