楼主
xmyjk |
Q:如何获取http://www.zhcw.com/ssq/，如动画示的数据系列。
即导出每期开奖的相关数据。
A:
难点1：数据存在于网页的JAVASCRIPT的变量中，如图
需要把他们导出来。
难点2：数据是在JS里面的变量，是以对象集合的形式存在的，需要转换后才能输出。
难点3：也是最难的，对象集合变量里面的每个对象的名称，是以数字形式存在的，VBA中，不允许变量名或者属性或者方法等以数字的形式存在的（例如X.111，是不合法的）。因此，采用CALLBYNAME的方法去提取。- Option Explicit
- Sub GetData()
- Dim v() As String, a, b, myjs, aa, bb, ARR(), BRR(), qh, i&
- Dim str As String
- [a1].CurrentRegion.Clear
- With CreateObject("Microsoft.XmlHttp") 'xmlhttp对象截取JS脚本变量数据
- .Open "POST", "http://www.zhcw.com/ssq/", False
- .setRequestHeader "Content-Type", "application/json; charset=UTF-8"
- .send
- v = Filter(Filter(Split(Trim(.responsetext), vbCrLf), "var", True), "!", False)
- End With
- Set myjs = CreateObject("MSScriptControl.ScriptControl") '调用ScriptControl对象将提取的变量文本运算形成对象集合
- str = v(0) & v(1) & v(2)
- myjs.Language = "javascript"
- myjs.addcode (str) '输入
- Set a = myjs.CodeObject.kjData '把开奖数据输出
- Set b = myjs.CodeObject.zjData
- qh = Split(myjs.CodeObject.issueNos, ",") '取得期号
- ReDim ARR(UBound(qh)) '构造输出数组
- ReDim BRR(UBound(qh))
- For i = 0 To UBound(qh)
- Set aa = CallByName(a, qh(i), VbGet) '按期号，从对象集合里面提取每一期的对象
- Set bb = CallByName(b, qh(i), VbGet)
- ARR(i) = aa.kjZNum '获取每一期中的数据属性
- BRR(i) = "销售额：" & bb.tzMoney & "一等奖奖金：" & bb.oneJ & "奖池累计金额" & bb.jcMoney
- Next
- [a1].Resize(UBound(qh) + 1, 1) = Application.Transpose(qh) '输出到单元格
- [b1].Resize(UBound(qh) + 1, 1) = Application.Transpose(ARR)
- [c1].Resize(UBound(qh) + 1, 1) = Application.Transpose(BRR)
- MsgBox "ok!"
- End Sub
 开奖数据提取.rar
|
