受限在网页上右击查看网页源代码,按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, "</a") Then sp = smid(sp, "<a", "/a") Else sp = smid(sp, "<td", "/td>") 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