目标要求:
爬取中国银行最新的汇率
爬取关键
- 获取网页字符串并保存到VBA变量中
- 使用正则表达式等方法处理字符串
首先进入网址
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,有这点作为底子,应该上手快一些