Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > Access数据库-窗体/数据页

从中国银行网站采集银行汇率

时 间:2017-12-08 11:23:29
作 者:大海   ID:42003  城市:深圳
摘 要:从指定网页采集数据的源代码示例。
正 文:

      因为工作的原因,需要实时获取当日的银行汇率,以前一直是通过打开网页复制获得数据,现在用access数据库制做了一个从中国银行网站上采集汇率的示例,感觉方便了很多。本示例的下载请点击屏幕左下角的“阅讯原文”,供大家参考!

代   码:

Sub 汇率采集()
    Dim url As String
    Dim hmlFile As Object
    Dim arr() As Variant
    Dim r As Variant
    Dim I As Integer
    Dim j As Integer
    Dim m As Integer
    Dim SQL1 As String
    Dim rst1 As New ADODB.Recordset
    CurrentDb.Execute "delete * from 中国银行汇率"
    url = "http://www.boc.cn/sourcedb/whpj"
    With CreateObject("microsoft.xmlhttp")
        .Open "GET", url, False
        .Send
        Do Until .ReadyState = 4
            DoEvents
        Loop
        Set hmlFile = CreateObject("htmlfile")
        hmlFile.body.innerhtml = .responsetext
    End With
    Set r = hmlFile.ALL.tags("table")(1).Rows
    ReDim arr(r.Length - 1, r(0).Cells.Length - 1)
    For I = 0 To UBound(arr)
        For j = 0 To UBound(arr, 2)
            arr(I, j) = r(I).Cells(j).innertext
        Next
    Next
    SQL1 = "select * from 中国银行汇率"
    rst1.Open SQL1, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    On Error Resume Next
    For m = 1 To UBound(arr)
        rst1.AddNew
        rst1!货币名称 = arr(m, 0)
        If arr(m, 1) <> "" Then rst1!现汇买入价 = arr(m, 1) Else rst1!现汇买入价 = 0
        If arr(m, 2) <> "" Then rst1!现汇卖出价 = arr(m, 2) Else rst1!现汇卖出价 = 0
        rst1!现钞买入价 = arr(m, 3)
        rst1!中行折算价 = arr(m, 4)
        rst1!现钞卖出价 = arr(m, 5)
        rst1!发布日期 = arr(m, 6)
        rst1!发布时间 = arr(m, 7)
        rst1.Update
    Next
    Set hmlFile = Nothing
    Set rst1 = Nothing
End Sub

附   件:

点击下载此附件


图   示:

点击图片查看大图




Access软件网QQ交流群 (群号:54525238)       Access源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助