全民一起VBA提高篇第十三课：简单爬虫

目标要求：
爬取中国银行最新的汇率

爬取关键

1. 获取网页字符串并保存到VBA变量中
2. 使用正则表达式等方法处理字符串

首先进入网址
https://www.boc.cn/sourcedb/whpj/

打开源网页
找到需要的这一部分

需要通过正则表达式除去标签部分

Option Explicit
Sub demo()
    Dim t
    
    t = Timer()
    Dim s As String, xh As Object
    
    Set xh = CreateObject("microsoft.xmlhttp")
    '调用网络访问组件，相当于人类双击打开浏览器
    xh.Open "get", "https://www.boc.cn/sourcedb/whpj/", False
    '调用open方法，指定URL，访问方法及同步异步
    '确定访问方法，get为只读，post还可以发送
    '后面跟一个URL
    'false为同步模式，是发送请求后，程序暂停运行，等待反馈后再运行
    'true为异步
    xh.send
    '提交请求，类似于回车
    s = xh.responsetext
    'responsetext得到网页字符串
    getrates s '调用函数
    
    MsgBox "用时" & Timer() - t & "秒"
    
End Sub

Sub getrates(s As String)

    Dim reg As Object, m As Object, mchs As Object
    Dim i As Long, j As Long, p As String
    
    Set reg = CreateObject("vbscript.regexp")
    '调用正则表达式组建
    
    p = "<tr>\s*<td>([^<]*)</td>\s*<td>([^<]*)</td>\s*<td>([^<]*)</td>\s*<td>([^<]*)</td>\s*<td>([^<]*)</td>\s*<td>([^<]*)</td>\s*<td\s*\S*>([^<]*)</td>\s*<td>([^<]*)</td>\s*</tr>"
    '<tr>+任意空白字符+<td>+匹配字符^或者<，子表达式零次或多次，二者一个或多个+<\td>+重复结构+<\tr>
    '重复结构<tr>\s*<td>([^<]*)</td>
    '但是注意有一个部分是\s*<td\s*\S*>([^<]*)</td>，这段结构有点点不同
    reg.Pattern = p
    reg.Global = True
    '同样的，先在网页编辑器中在线测试后再粘贴过来
    Set mchs = reg.Execute(s)
    '执行reg语句
    i = 2
    For Each m In mchs
        For j = 0 To m.submatches.Count - 1
            Cells(i, j + 1) = m.submatches.Item(j)
            '利用submatch进行赋值，得到每个分组后的结果
        Next j
        i = i + 1
    Next m
    
End Sub

上述代码较为复杂，需要慢慢读，尤其是正则表达式的部分

最后可以得到如下结果

和原网页对比

当然，对于单一的网页复制粘贴，写代码还是太复杂和麻烦了，但是耐不住两大，不过，有一说一，现在的网页基本没有这么简单的，所以这里权当练手，实战基本用不上

等后面学了python，有这点作为底子，应该上手快一些