刚学VBA网页数据获取，请教一些问题

脱壳的蜗牛

lsdongjh 发表于 2017-4-1 14:10
在64位OFFICE中可以这样处理：

难道是我的环境问题吗？
Debug.Print objJS.Summary.Total
这段报错：对象不支持该属性或方法。

还有监视窗口，要把上面那段话放到endsub前面，监视窗口才有内容。
这是什么原因呢？麻烦你了

Kaohsing

7楼的代码： objJS.AddCode strTemp‘是strTemp，不是strT

1. 
   
2. Sub Test()
   
3.     Dim objJS As Object
   
4.     Dim strTemp As String
   
5.     Dim intPageTotal As Integer
   
6.    
   
7.     strTemp = "var gs={Summary:{pages:123,page:1,total:267,DateTime:""2017-03-31 22:00:07""},Item:[{name:""精雕机"",id:""A100001"",code:""307451"",price:252.1,zj:-1.3,stats:1,time:""08:30:00"",total:329849.2},{name:""角磨机"",id:""A100351"",code:""683426"",price:138.05,zj:0.28,stats:1,time:""08:42:03"",total:142197.5}]}"
   
8.    
   
9.     Set objJS = CreateObject("ScriptControl")
   
10.     objJS.Language = "JScript"
    
11.     objJS.AddCode strTemp‘<font color="#ff0000" size="4">是strTemp，不是strT</font>
    
12.    
    
13.     intPageTotal = objJS.eval("gs.Summary.total")
    
14. End Sub

复制代码

脱壳的蜗牛

Kaohsing 发表于 2017-4-1 14:21
书读百遍。

谢谢kao哥，正想着先把代码写好了，再弄个按钮，这下好了，两个可以一起学了，非常感谢

Kaohsing

脱壳的蜗牛 发表于 2017-4-1 14:41
难道是我的环境问题吗？
Debug.Print objJS.Summary.Total
这段报错：对象不支持该属性或方法。

在     Debug.Print "total: " & objJS.Summary.total前面加一句 Dim total就OK啦，total好像是Javascript什么词来着

cunfu2010

lsdongjh 发表于 2017-4-1 13:47
试试这个方式：
你要的内容就是 gs.Item

请教老师如何得到Item下的值，即输出到工作表中？

lsdongjh

cunfu2010 发表于 2018-9-21 16:03
请教老师如何得到Item下的值，即输出到工作表中？

1. Sub Test()
   
2.     Dim strTemp As String
   
3.     Dim objHTML As Object, objWin As Object, objJS As Object
   
4.    
   
5.     Dim objItems As Object
   
6.     Dim lngRows As Long, lngRow As Long
   
7.     Dim arrResult As Variant
   
8.    
   
9.     strTemp = "var gs={Summary:{pages:123,page:1,total:267,DateTime:""2017-03-31 22:00:07""},Item:[{name:""精雕机"",id:""A100001"",code:""307451"",price:252.1,zj:-1.3,stats:1,time:""08:30:00"",total:329849.2},{name:""角磨机"",id:""A100351"",code:""683426"",price:138.05,zj:0.28,stats:1,time:""08:42:03"",total:142197.5}]}"
   
10. 
    
11.     Set objHTML = CreateObject("htmlfile")
    
12.     Set objWin = objHTML.parentWindow
    
13.     objWin.execScript strTemp, "JScript"
    
14.    
    
15.     lngRows = objWin.eval("gs.Item.length")
    
16.     ReDim arrResult(1 To lngRows, 1 To 8)
    
17.     For lngRow = 1 To lngRows
    
18.         arrResult(lngRow, 1) = objWin.eval("gs.Item[" & lngRow - 1 & "].name")
    
19.         arrResult(lngRow, 2) = objWin.eval("gs.Item[" & lngRow - 1 & "].id")
    
20.         arrResult(lngRow, 3) = objWin.eval("gs.Item[" & lngRow - 1 & "].code")
    
21.         arrResult(lngRow, 4) = objWin.eval("gs.Item[" & lngRow - 1 & "].price")
    
22.         arrResult(lngRow, 5) = objWin.eval("gs.Item[" & lngRow - 1 & "].zj")
    
23.         arrResult(lngRow, 6) = objWin.eval("gs.Item[" & lngRow - 1 & "].stats")
    
24.         arrResult(lngRow, 7) = objWin.eval("gs.Item[" & lngRow - 1 & "].time")
    
25.         arrResult(lngRow, 8) = objWin.eval("gs.Item[" & lngRow - 1 & "].total")
    
26.     Next
    
27.    
    
28.     Sheet1.UsedRange.ClearContents
    
29.     Sheet1.Range("A1:H1") = Array("name", "id", "code", "price", "zj", "stats", "time", "total")
    
30.     Sheet1.Range("A2").Resize(lngRows, 8) = arrResult
    
31. End Sub

复制代码

Kaohsing

cunfu2010 发表于 2018-9-21 16:03
请教老师如何得到Item下的值，即输出到工作表中？

1. Sub kao()
   
2.    
   
3.     Dim x As Object
   
4.     Dim strJson As String
   
5.     Set x = CreateObject("scriptcontrol")
   
6.     x.Language = "jscript"
   
7.     Cells.Clear
   
8.     strJson = "{Summary:{pages:123,page:1,total:267,DateTime:""2017-03-31 22:00:07""},Item:[{name:""精雕机"",id:""A100001"",code:""307451"",price:252.1,zj:-1.3,stats:1,time:""08:30:00"",total:329849.2},{name:""角磨机"",id:""A100351"",code:""683426"",price:138.05,zj:0.28,stats:1,time:""08:42:03"",total:142197.5}]}"
   
9.     x.AddObject "rng", ActiveSheet.Range("A1")
   
10.     x.eval ("var kao=" & strJson & ".Item ;var i,r,row=1;for(i in kao){ c=1;for(r in kao[i]){if(row==1){rng(1,c)=r;}; rng(row+1,c)=kao[i][r];c++;}  row++;};")
    
11.     MsgBox "job  okey!"
    
12.    
    
13. End Sub

复制代码

Kaohsing

          附件： kao_js.rar (6.74 KB, 下载次数: 3)

2018-9-22 11:42 上传

点击文件名下载附件

kings12333

Kaohsing 发表于 2018-9-22 11:42
附件：

Kaohsing老师，帮忙取下这个网址右手边“板块异动"中的数据，谢谢！ 网址如下：https://www.yuncaijing.com/replay/replay_realtime.html

cunfu2010

Kaohsing 发表于 2018-9-22 11:40

x.eval ("var kao=" & strJson & ".Item ;var i,r,row=1;for(i in kao){ c=1;for(r in kao){if(row==1){rng(1,c)=r;}; rng(row+1,c)=kao[r];c++;}  row++;};")
这句看不懂，还要多学习。