如何使用vba抓取js动态网页数据

小小莘

网址：http://www.sse.com.cn/disclosure/listedinfo/periodic/             （上证定期报告披露时间）
这个网页通过这个链接获取数据http://query.sse.com.cn/infodisplay/queryBltnBookInfo.do?jsonCallBack=jsonpCallback60659&isPagination=true&isNew=1&bulletintype=L013&publishYear=2017&cmpCode=&startTime=&sortName=companyCode&direction=asc&pageHelp.pageSize=25&pageHelp.pageCount=50&pageHelp.pageNo=48&pageHelp.beginPage=48&pageHelp.cacheSize=1&pageHelp.endPage=481&_=1492418921607
红色的为变动的，只能用一次，再次访问就提示错误如何确定红色的是有哪个js文件确定的？
以及如何在vba中引用这个js文件生成数字？
谢谢大神

liu-aguang

1.     Set oDom = CreateObject("htmlfile")
   
2.     Set oWin = oDom.parentWindow
   
3.     oWin.execScript
   
4.     jsonpCallback = oWin.eval("'jsonpCallback' + Math.floor(Math.random() * (100000 + 1))")
   
5.     t = oWin.eval("new Date().getTime()")
   

复制代码

duquancai

标记一下            

kings12333

liu-aguang 发表于 2017-4-17 18:02

猫神好，好久没见猫神了。。。忍不住打个招呼

小小莘

liu-aguang 发表于 2017-4-17 18:02

大神
用了上面的方法还是显示403
能棒我看下代码不

1. 'http://query.sse.com.cn/infodisplay/queryBltnBookInfo.do?jsonCallBack=jsonpCallback66035&isPagination=true&isNew=1&bulletintype=L013&publishYear=2017&cmpCode=&startTime=&sortName=companyCode&direction=asc&pageHelp.pageSize=25&pageHelp.pageCount=50&pageHelp.pageNo=2&pageHelp.beginPage=2&pageHelp.cacheSize=1&pageHelp.endPage=21&_=1492432490755
   
2. Sub 按钮1_Click()
   
3.     Set oDom = CreateObject("htmlfile")
   
4.     Set oWin = oDom.parentWindow
   
5.     oWin.execScript
   
6.     jsonpcallback = oWin.eval("'jsonpCallback' + Math.floor(Math.random() * (100000 + 1))")
   
7.     t = oWin.eval("new Date().getTime()")
   
8.     URL = "http://query.sse.com.cn/infodisplay/queryBltnBookInfo.do?jsonCallBack=" & jsonpcallback & "&isPagination=true&isNew=1&bulletintype=L013&publishYear=2017&cmpCode=&startTime=&sortName=companyCode&direction=asc&pageHelp.pageSize=25&pageHelp.pageCount=50&pageHelp.pageNo=2&pageHelp.beginPage=2&pageHelp.cacheSize=1&pageHelp.endPage=21&_=" & t
   
9.     Cells(1, 1) = jsonpcallback
   
10.     Cells(1, 4) = t
    
11.     Cells(2, 1) = URL
    
12.     Set objXML = CreateObject("Microsoft.XMLHTTP")
    
13.     With objXML
    
14.         .Open "GET", URL, False
    
15.         .send
    
16.         Cells(3, 1) = .Status
    
17.     End With  
    
18. End Sub
    

复制代码

liu-aguang

小小莘 发表于 2017-4-17 20:57
大神
用了上面的方法还是显示403
能棒我看下代码不

1. Sub 按钮1_Click()
   
2.     Set oDom = CreateObject("htmlfile")
   
3.     Set oWin = oDom.parentWindow
   
4.     oWin.execScript
   
5.     jsonpcallback = oWin.eval("'jsonpCallback' + Math.floor(Math.random() * (100000 + 1))")
   
6.     t = oWin.eval("new Date().getTime()")
   
7.     URL = "http://query.sse.com.cn/infodisplay/queryBltnBookInfo.do?jsonCallBack=" & jsonpcallback & "&isPagination=true&isNew=1&bulletintype=L013&publishYear=2017&cmpCode=&startTime=&sortName=companyCode&direction=asc&pageHelp.pageSize=25&pageHelp.pageCount=50&pageHelp.pageNo=1&pageHelp.beginPage=1&pageHelp.cacheSize=1&pageHelp.endPage=5&_=" & t
   
8.     Cells(1, 1) = jsonpcallback
   
9.     Cells(1, 4) = t
   
10.     Cells(2, 1) = URL
    
11.     Set objXML = CreateObject("WinHttp.WinHttpRequest.5.1")
    
12.     With objXML
    
13.         .Open "GET", URL, False
    
14.         .setRequestHeader "Referer", "http://www.sse.com.cn/disclosure/listedinfo/periodic/"
    
15.         .send
    
16.         Cells(3, 1) = .Status
    
17.     End With
    
18. End Sub
    

复制代码

小小莘

kknddnkk 发表于 2017-4-18 01:52
我拷贝了代码，运行后出现下列结果
感觉不是楼主想要的啊，求教是哪里出错了

这个代码还没完成，只是获取网页数据， 200意味着数据获取成功，403意味着数据获取失败。后面还需对数据进行处理。

小小莘

liu-aguang 发表于 2017-4-17 23:00

大神
现在出现了各新问题，数据存在重复现象，每个数据都有两个一样的
能再帮忙看下代码吗
十分感谢

1. Sub 按钮1_Click()
   
2. 
   
3.     Set oDom = CreateObject("htmlfile")
   
4.     Set oWin = oDom.parentWindow
   
5.     oWin.execScript
   
6.     jsonpcallback = oWin.eval("'jsonpCallback' + Math.floor(Math.random() * (100000 + 1))")
   
7.     t = oWin.eval("new Date().getTime()")
   
8.     URL = "http://query.sse.com.cn/infodisplay/queryBltnBookInfo.do?jsonCallBack=" & jsonpcallback & "&isPagination=true&isNew=1&bulletintype=L013&publishYear=2017&cmpCode=&startTime=&sortName=companyCode&direction=asc&pageHelp.pageSize=1500&pageHelp.pageCount=1&pageHelp.pageNo=1&pageHelp.beginPage=1&pageHelp.cacheSize=1&pageHelp.endPage=1&_=" & t
   
9.     Cells(1, 1) = jsonpcallback
   
10.     Cells(1, 4) = t
    
11.     Set objXML = CreateObject("WinHttp.WinHttpRequest.5.1")
    
12.     With objXML
    
13.         .Open "GET", URL, False
    
14.         .setRequestHeader "Referer", "http://www.sse.com.cn/disclosure/listedinfo/periodic/"
    
15.         .send
    
16.         Cells(3, 1) = .Status
    
17.         txtcontent = .responsetext
    
18.     End With
    
19.     arrT1 = Split(txtcontent, ",{")
    
20.                 Cells(3, 3) = UBound(arrT1)
    
21.                 Cells(4, 1) = "披露时间"
    
22.                 Cells(4, 2) = "报告类型"
    
23.                 Cells(4, 3) = "股票名称"
    
24.                 Cells(4, 4) = "股票代码"
    
25.                 Cells(4, 5) = "不明"
    
26.                 Cells(4, 6) = "首次预约时间"
    
27.                 Cells(4, 7) = "一次变更日"
    
28.                 Cells(4, 8) = "二次变更日"
    
29.                 Cells(4, 9) = "三次变更日"
    
30.                 Cells(4, 10) = "披露年份"
    
31.                 Cells(4, 11) = "不明"
    
32.   For i = 1 To UBound(arrT1)
    
33.                 arrT2 = Split(arrT1(i), ",")
    
34.                 Cells(3, 6) = UBound(arrT2)
    
35.                 For j = 0 To UBound(arrT2)
    
36.                 arrT2(j) = Mid(arrT2(j), InStrRev(arrT2(j), ":") + 2)
    
37.                Next j
    
38.                 Cells(i + 4, 1) = arrT2(1)
    
39.                 Cells(i + 4, 2) = arrT2(2)
    
40.                 Cells(i + 4, 3) = arrT2(3)
    
41.                 Cells(i + 4, 4) = arrT2(4)
    
42.                 Cells(i + 4, 5) = arrT2(5)
    
43.                 Cells(i + 4, 6) = arrT2(6)
    
44.                 Cells(i + 4, 7) = arrT2(7)
    
45.                 Cells(i + 4, 8) = arrT2(8)
    
46.                 Cells(i + 4, 9) = arrT2(9)
    
47.                 Cells(i + 4, 10) = arrT2(10)
    
48.                 Cells(i + 4, 11) = arrT2(11)
    
49.   Next i
    
50.       Cells.Replace What:="ull", Replacement:="", LookAt:=xlPart, SearchOrder _
    
51.         :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    
52.       Cells.Replace What:=Chr(34), Replacement:="", LookAt:=xlPart, SearchOrder _
    
53.         :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    
54.       Cells.Replace What:="}", Replacement:="", LookAt:=xlPart, SearchOrder _
    
55.         :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    
56.       Cells.Replace What:="]", Replacement:="", LookAt:=xlPart, SearchOrder _
    
57.         :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    
58.       Cells.Columns.AutoFit
    
59. End Sub

复制代码

Kaohsing

小小莘 发表于 2017-4-18 11:21
大神
现在出现了各新问题，数据存在重复现象，每个数据都有两个一样的
能再帮忙看下代码吗

kao.rar (97.89 KB, 下载次数: 227)

2017-4-18 12:52 上传

点击文件名下载附件