excelvba抓取网页数据(我前一阵子用XMLHTTP的Get功能抓取邮件轨迹(图) )

　　excelvba抓取网页数据(我前一阵子用XMLHTTP的Get功能抓取邮件轨迹(图)

)

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

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

　　

　　上图中的“Entity”内容用于设置header。点击“TextView”可以看到传输的参数内容和邮箱号，如下图：

　　

　　获取数据的代码如下：

　　Sub tt()

Dim HttpReq As Object

Dim pdata, http As String

Set 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, False

HttpReq.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 = 4

DoEvents

Loop

If HttpReq.Status = 200 Then

Debug.Print HttpReq.responseText

End If

End Sub

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

　　

　　点击“JSON”查看数据分析结果：

　　

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

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

　　'要返回数据成为标准的json结构，还需要在外面加一层数据名

　　buf = "{""traces"":" & HttpReq.responseText & "}"

　　kk = get_trace(buf)

　　get_trace函数用于解析json数据，代码如下：

<p>Function get_trace(mystring As String) As Integer

Dim objJSx As Object, objJSy As Object

Dim m1, m2, n, j As Integer

Dim source, level, kind, sm As String

On Error Resume Next

Set 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 jscode

TT = "否"

For n = 1 To 100

If objJSx.Run("json", mystring, n - 1) = "" Then Exit For

Set objJSy = objJSx.Run("json", mystring, n - 1)

For j = 1 To 11

TraceInfo(n, j) = ""

Next j

TraceInfo(n, 1) = objJSy.traceNo

TraceInfo(n, 2) = objJSy.opCode

TraceInfo(n, 3) = objJSy.opTime

TraceInfo(n, 4) = objJSy.opName

TraceInfo(n, 6) = objJSy.opOrgCode

TraceInfo(n, 7) = objJSy.opOrgSimpleName

TraceInfo(n, 8) = objJSy.operatorNo

TraceInfo(n, 9) = objJSy.operatorName

TraceInfo(n, 10) = objJSy.level

TraceInfo(n, 11) = objJSy.source

sm = objJSy.desc

'剔除数据中的HTML部分

Do While InStr(sm, "