vba抓取html源码数据,VBA登录抓取网络数据
受限在网页上右击查看网页源代码，按Ctrl+F搜索form表单，找到post的网址(或者自身就是post的网址)，然后找到账号和密码的name，用来做VBA里Send的Data，这样登录完就可以直接post数据获取网址获取网页数据了，这里举例代码最后是返回文本，可以用left和right配合instr、invinstr、len等反复截取文本，或者直接用正则表达式。
Set http = CreateObject("Msxml2.ServerXMLHTTP")
http.Open "post", "登录网址", False
http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
Data = "username=账号&password=密码"
http.send (Data)
http.Open "post", "数据获取网址", False
http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
Data = "参数名=参数值"
http.send (Data)
html = http.responsetext
If InStr(HTML, "由于访问订单详情页过于频繁") > 0 Then '绕过验证码
http.Open "post", "http://om.jd.com/verify_doOrderInfoverify", False
http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
Data = "codes=&returnUrl=http://om.jd.com/detail"
http.send (Data)
HTML = http.responsetext
'未测试是否返回原网页
End If
文本处理的子函数举例
Function sf(a, b, c, d) '文本存在判断返回
If InStr(a, b) <> 0 Then
sf = c
Else
sf = d
End If
End Function
Function smid(a, b, c) '截取首次出现文本中间
If InStr(a, b) > 0 Then
smid = Right(a, Len(a) - InStr(a, b) - Len(b) + 1)
If InStr(smid, c) > 0 Then
smid = Left(smid, InStr(smid, c) - 1)
End If
End If
End Function
Function sp(a, b, c) 'HTML关键字截取
sp = smid(a, b, c)
If InStr(sp, "
sp = smid(sp, "
Else
sp = smid(sp, "
")End If
sp = smid(sp, ">", "
sp = Replace(sp, Chr(10), "")
sp = Replace(sp, Chr(11), "")
sp = Replace(sp, Chr(13), "")
sp = Replace(sp, " ", "")
End Function