【VBA研究】用XMLHTTP的Post功能抓取数据

作者：iamlaosong

我前一阵子用VBA做了个工具，用XMLHTTP的Get功能抓取城市间距离。现在我想用用XMLHTTP的Post功能抓取邮件轨迹。抓取数据是用Get还是Post，取决于网站提交参数的方法。

1、通过分析（用fiddler），邮件轨迹查询网站是用post提交参数的。如下图：

上图中“Entity”内容用于设置包头，点击“TextView”可以看到传输的参数内容，邮件号码，如下图：

抓取数据的代码如下：

Sub tt()Dim HttpReq As ObjectDim pdata, http As StringSet HttpReq = CreateObject("MSXML2.XMLHTTP.6.0")'轨迹头部数据，网址用xxx屏蔽http = "http://10.xxx.xxx.xxx/querypush-traln/qps/qpswaybilltraceinternal/queryTraceByTrace_no/"pdata = "trace_no=1044905987232"HttpReq.Open "Post", http, FalseHttpReq.setRequestHeader "Content-Length", Len(pdata)'HttpReq.setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded"HttpReq.setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded; charset=utf-8"HttpReq.send pdata    '"trace_nos=1194359346482"Do Until HttpReq.readyState = 4DoEventsLoopIf HttpReq.Status = 200 ThenDebug.Print HttpReq.responseTextEnd IfEnd Sub

2、返回内容是个json结构的数据，可以用fiddler的查看返回内容，点击“TextView”：

点击“JSON”可以看到数据解析结果：

但vba解析的时候内容为空，对比以前返回json结构的数据，发现这个数据少了个名称，因为定义JS函数时，指定了一个json结构数据的名称，即jscode = "function json(s,i) { return eval('(' + s + ').traces[' + i + ']'); }"中的traces名称。

加上后就可以解析了，即：

'返回数据要成为标准的json结构，还需要在外面加一层数据名称
buf = "{""traces"":" & HttpReq.responseText & "}"
kk = get_trace(buf)
get_trace函数就是用来解析json数据的，代码如下：

Function get_trace(mystring As String) As IntegerDim objJSx As Object, objJSy As ObjectDim m1, m2, n, j As IntegerDim source, level, kind, sm As StringOn Error Resume NextSet objJSx = CreateObject("ScriptControl")        '调用MSScriptControl.ScriptControl对象将提取的变量文本运算形成对象集合objJSx.Language = "JavaScript"                    '测试发现JavaScript、javascript、JScript都可以表示JavaScript语言'定义一个JS函数，通过计算表达式的方式引入JSON数据并解析jscode = "function json(s,i) { return eval('(' + s + ').traces[' + i + ']'); }"objJSx.AddCode jscodeTT = "否"For n = 1 To 100If objJSx.Run("json", mystring, n - 1) = "" Then Exit ForSet objJSy = objJSx.Run("json", mystring, n - 1)For j = 1 To 11TraceInfo(n, j) = ""Next jTraceInfo(n, 1) = objJSy.traceNoTraceInfo(n, 2) = objJSy.opCodeTraceInfo(n, 3) = objJSy.opTimeTraceInfo(n, 4) = objJSy.opNameTraceInfo(n, 6) = objJSy.opOrgCodeTraceInfo(n, 7) = objJSy.opOrgSimpleNameTraceInfo(n, 8) = objJSy.operatorNoTraceInfo(n, 9) = objJSy.operatorNameTraceInfo(n, 10) = objJSy.levelTraceInfo(n, 11) = objJSy.sourcesm = objJSy.desc'剔除数据中的HTML部分Do While InStr(sm, "<") > 0m1 = InStr(sm, "<")m2 = InStr(sm, ">")If m2 > 0 ThenIf Mid(sm, m1, 3) = "/br" Thensm = Left(sm, m1 - 1) & " " & Right(sm, Len(sm) - m2)Elsesm = Left(sm, m1 - 1) & Right(sm, Len(sm) - m2)End IfElseExit DoEnd IfLoopTraceInfo(n, 5) = smIf objJSy.opCode = "704" Then TT = "是"Next nget_trace = n - 1
End Function

3、实际使用的代码

Public Sub get_data()'根据工作表中的查询语句读取数据Dim HttpReq As ObjectDim i, k, kk, lineno, row1 As LongDim Mail, pdata, tbhead As String, buf As StringDim arr_headlineno = [A65536].End(xlUp).Row      '行数，也是邮件号码数量Range("B2:B" & lineno).ClearContents'lineno = ActiveSheet.UsedRange.Rows.CountSet HttpReq = CreateObject("MSXML2.XMLHTTP.6.0")'轨迹头部数据'http = "http://10.xxx.xxx.xxx/querypush-traln/qps/qpswaybilltraceinternal/queryCurrentTraceByTrace_nos/"'pdata = "trace_nos="'轨迹数据http = "http://10.xxx.xxx.xxx/querypush-traln/qps/qpswaybilltraceinternal/queryTraceByTrace_no/"'pdata = "trace_no="row1 = 2maxrow = Sheets("查询结果").UsedRange.Rows.CountIf maxrow >= 1 ThenSheets("查询结果").Range("A1:L" & maxrow).ClearContentsEnd Iftbhead = "邮件号码 操作码 操作时间 处理动作 详细说明 机构代码 机构名称 操作员代码 操作员姓名 级别 来源"arr_head = Split(tbhead, " ")    '下标从0开始Sheets("查询结果").Cells(1, 1).Resize(1, UBound(arr_head) + 1) = arr_headFor i = 2 To linenoMail = Trim(Sheets("邮件号码").Cells(i, 1))If Mail = "" Then Exit ForIf Len(Mail) = 13 ThenHttpReq.Open "Post", http, Falsepdata = "trace_no=" & MailHttpReq.setRequestHeader "Content-Length", Len(pdata)HttpReq.setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded"HttpReq.send pdata    'pdata = "trace_no=1194359346482"Do Until HttpReq.readyState = 4DoEventsLoop'MsgBox HttpReq.getAllResponseHeaders'Debug.Print HttpReq.responseText'返回数据要成为标准的json结构，还需要在外面加一层数据名称buf = "{""traces"":" & HttpReq.responseText & "}"kk = get_trace(buf)Sheets("邮件号码").Cells(i, 2) = TTIf kk > 0 ThenFor k = kk To 1 Step -1If CInt(TraceInfo(k, 10)) <= Range("E1") ThenFor j = 1 To 11Sheets("查询结果").Cells(row1, j) = TraceInfo(k, j)Next jrow1 = row1 + 1End IfNext kElseSheets("邮件号码").Cells(i, 2) = "Err"Sheets("查询结果").Cells(row1, 1) = MailSheets("查询结果").Cells(row1, 2) = "Err"Sheets("查询结果").Cells(row1, 4) = HttpReq.responseTextrow1 = row1 + 1delay (9 * Rnd + 1)   '出错了，说明你还是干快了，随机后延时1-10秒，看运气了。End If'If CInt(i / 10) * 10 = i ThenApplication.StatusBar = "完成：" & Round(i * 100 / lineno, 2) & "%"DoEvents'End Ifdelay (Rnd + 0.25)  '总部领导说了，接口是大家用的，你一个人不能用太多，此处延时0.5秒，降降速度。ElseSheets("邮件号码").Cells(i, 2) = "异常"End IfNext iApplication.StatusBar = "就绪"Sheets("查询结果").Activatemsg = MsgBox("邮件批量查询完毕，共查询" & i - 2 & "个邮件！", vbOKOnly, "ＡＨＥＭＳ：iamlaosong")End Sub

【VBA研究】用XMLHTTP的Post功能抓取数据相关推荐

系统检测到您正在使用网页抓取工具访问_从网站抓取数据的3种最佳方法
halo,大家好,我是特仑苏,今天呢给大家分享一些Python从网站抓取数据的一些方法,希望可以给大家带来一些帮助! 原作者:Octoparse团队原出处:作品文(从网站抓取数据的3种最佳方法)/网 ...
网页抓取/数据抽取/信息提取软件工具包MetaSeeker
MetaSeeker是一个Web网页抓取/数据抽取/页面信息提取工具包,能够按照用户的指导,从Web页面上筛选出需要的信息,并输出含有语义结构的提取结果文件(XML文件),众所周知,Web页面显示的信 ...
python怎么编写wireshark抓的包_使用Wireshark 抓取数据包
Wireshark 是一个网络封包分析软件.网络封包分析软件的功能是获取网络封包,并尽可能显示出最为详细的网络封包资料.Wireshark使用WinPCAP作为接口,直接与网卡进行数据报文交换. 一 ...
libpcap抓取数据包
libpcap是数据包捕获函数库.该库提供的C函数接口可用于需要捕获经过网络接口数据包的系统开发上.libpcap提供的接口函数主要实现和封装了与数据包截获有关的过程.这个库为不同的平台提供了一致的编 ...
使用Apache Flume抓取数据（1）
使用Apache Flume抓取数据,怎么来抓取呢?不过,在了解这个问题之前,我们必须明确ApacheFlume是什么? 一.什么是Apache Flume Apache Flume是用于数据采集的高 ...
python 定时自动爬取_python实现scrapy爬虫每天定时抓取数据的示例代码
1. 前言. 1.1. 需求背景. 每天抓取的是同一份商品的数据,用来做趋势分析. 要求每天都需要抓一份,也仅限抓取一份数据. 但是整个爬取数据的过程在时间上并不确定,受本地网络,代理速度,抓取数据量 ...
python定时爬取数据_python实现scrapy爬虫每天定时抓取数据的示例代码
1. 前言. 1.1. 需求背景. 每天抓取的是同一份商品的数据,用来做趋势分析. 要求每天都需要抓一份,也仅限抓取一份数据. 但是整个爬取数据的过程在时间上并不确定,受本地网络,代理速度,抓取数据量 ...
测试开发Python培训：抓取新浪微博抓取数据-技术篇
测试开发Python培训:抓取新浪微博抓取数据-技术篇 poptest是国内唯一一家培养测试开发工程师的培训机构,以学员能胜任自动化测试,性能测试,测试工具开发等工作为目标.在poptest的sele ...
基于Thinkphp5+phpQuery 网络爬虫抓取数据接口,统一输出接口数据api
TP5_Splider 一个基于Thinkphp5+phpQuery 网络爬虫抓取数据接口统一输出接口数据api.适合正在学习Vue,AngularJs框架学习开发demo,需要接口并保证接口不跨 ...

【VBA研究】用XMLHTTP的Post功能抓取数据

【VBA研究】用XMLHTTP的Post功能抓取数据相关推荐

最新文章

热门文章