VBA 抓取当前美金兑换率 winhttp版

时　间:2014-05-01 11:26:11
作　者:dbaseIIIer   ID：22003  城市：深圳
摘　要:今天承诺了一位朋友给出答案的，就很简单节省每天读取中国银行美金兑换率。可是我还没有安装 Access2010，也觉得要求中，用WebBrowser控件有点不够效率，所以还是给出最后的这个方案。
正　文:

运行这个代码需要引用几个库：

Microsoft WinHTTP services, version 5.1

Microsoft VBScript Regular Expression 5.5 (其实你本机有什么版本都可以）

WinHTTP 动态库，其实执行起来会比 WebBrowser控件 用少很多资源，至少不需要网页渲染引擎！

比起 MSXML.ServerXMLHTTP30 也会轻松点。

建造一个共用函数：

Public Function currentUSD()

    Dim re As RegExp, mc As MatchCollection
    Dim http As WinHttp.WinHttpRequest
    Set http = New WinHttp.WinHttpRequest
    http.Open "GET", "http://www.boc.cn/sourcedb/whpj/"
    http.SetTimeouts 3, 3, 3, 3
    http.Send
    http.WaitForResponse

    txt = StrConv(http.ResponseBody, vbUnicode)

    Set re = New RegExp
    re.Pattern = "缇庡厓<\/td>\s+([\d\.]+<\/td>\s+[\d\.]+<\/td>\s+[\d\.]+<\/td>\s+[\d\.]+<\/td>\s+[\d\.]+<\/td>\s+[\d\-]+<\/td>\s+[\d\:]+)<\/td>"
    Set mc = re.Execute(txt)
    txt = mc(0).SubMatches(0)
    re.Pattern = "<\/td>\s+"
    re.Global = True
    currentUSD = re.Replace(txt, ",")

End Function

我这里没有加上任何的错误检测，错误处理。譬如：

1. 读取网络超时：http.WaitForResponse 之后检测 http.readystate=200 才是正常的；

2. 匹配 “美金” 我用了 utf8 的 “缇庡厓” 直接搜索，假设本页一定会有结果；

这些就留给同学们自己玩了！

另外，我用了 RegExp，非常好用的文本处理工具，但是因为非常强大的工具，所以就不要问我怎么用了！

用法：

在代码里面用  变量 = CurrentUSD() 就可以了。

即时窗口中测试：

    ? currentUSD
    624.55,619.54,627.05,627.05,615.8,2014-05-01,10:49:02