一个基于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'   voidFunction 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    NextEnd Function

4. 完成作品效果演示

Let us have a look！

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

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

5. 总结

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