ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 12090|回复: 12

[求助] 如何使用vba抓取js动态网页数据

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-4-17 17:07 | 显示全部楼层 |阅读模式
网址: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文件生成数字?
谢谢大神
UN2OBXJQNA9S`}NLH03Q@JQ.png

TA的精华主题

TA的得分主题

发表于 2017-4-17 18:02 | 显示全部楼层
  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()")
复制代码

TA的精华主题

TA的得分主题

发表于 2017-4-17 18:10 来自手机 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2017-4-17 18:12 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-4-17 20:57 | 显示全部楼层

大神
用了上面的方法还是显示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
复制代码

TA的精华主题

TA的得分主题

发表于 2017-4-17 23:00 | 显示全部楼层
小小莘 发表于 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
复制代码
头像被屏蔽

TA的精华主题

TA的得分主题

发表于 2017-4-18 01:52 | 显示全部楼层

TA的精华主题

TA的得分主题

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

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

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-4-18 11:21 | 显示全部楼层

大神
现在出现了各新问题,数据存在重复现象,每个数据都有两个一样的
能再帮忙看下代码吗
十分感谢
  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=1500&pageHelp.pageCount=1&pageHelp.pageNo=1&pageHelp.beginPage=1&pageHelp.cacheSize=1&pageHelp.endPage=1&_=" & t
  8.     Cells(1, 1) = jsonpcallback
  9.     Cells(1, 4) = t
  10.     Set objXML = CreateObject("WinHttp.WinHttpRequest.5.1")
  11.     With objXML
  12.         .Open "GET", URL, False
  13.         .setRequestHeader "Referer", "http://www.sse.com.cn/disclosure/listedinfo/periodic/"
  14.         .send
  15.         Cells(3, 1) = .Status
  16.         txtcontent = .responsetext
  17.     End With
  18.     arrT1 = Split(txtcontent, ",{")
  19.                 Cells(3, 3) = UBound(arrT1)
  20.                 Cells(4, 1) = "披露时间"
  21.                 Cells(4, 2) = "报告类型"
  22.                 Cells(4, 3) = "股票名称"
  23.                 Cells(4, 4) = "股票代码"
  24.                 Cells(4, 5) = "不明"
  25.                 Cells(4, 6) = "首次预约时间"
  26.                 Cells(4, 7) = "一次变更日"
  27.                 Cells(4, 8) = "二次变更日"
  28.                 Cells(4, 9) = "三次变更日"
  29.                 Cells(4, 10) = "披露年份"
  30.                 Cells(4, 11) = "不明"
  31.   For i = 1 To UBound(arrT1)
  32.                 arrT2 = Split(arrT1(i), ",")
  33.                 Cells(3, 6) = UBound(arrT2)
  34.                 For j = 0 To UBound(arrT2)
  35.                 arrT2(j) = Mid(arrT2(j), InStrRev(arrT2(j), ":") + 2)
  36.                Next j
  37.                 Cells(i + 4, 1) = arrT2(1)
  38.                 Cells(i + 4, 2) = arrT2(2)
  39.                 Cells(i + 4, 3) = arrT2(3)
  40.                 Cells(i + 4, 4) = arrT2(4)
  41.                 Cells(i + 4, 5) = arrT2(5)
  42.                 Cells(i + 4, 6) = arrT2(6)
  43.                 Cells(i + 4, 7) = arrT2(7)
  44.                 Cells(i + 4, 8) = arrT2(8)
  45.                 Cells(i + 4, 9) = arrT2(9)
  46.                 Cells(i + 4, 10) = arrT2(10)
  47.                 Cells(i + 4, 11) = arrT2(11)
  48.   Next i
  49.       Cells.Replace What:="ull", Replacement:="", LookAt:=xlPart, SearchOrder _
  50.         :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
  51.       Cells.Replace What:=Chr(34), Replacement:="", LookAt:=xlPart, SearchOrder _
  52.         :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
  53.       Cells.Replace What:="}", Replacement:="", LookAt:=xlPart, SearchOrder _
  54.         :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
  55.       Cells.Replace What:="]", Replacement:="", LookAt:=xlPart, SearchOrder _
  56.         :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
  57.       Cells.Columns.AutoFit
  58. End Sub
复制代码

获取上证定期报告披露时间(出现重复).rar

90.84 KB, 下载次数: 85

TA的精华主题

TA的得分主题

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

kao.rar (97.89 KB, 下载次数: 170)
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-10-22 12:24 , Processed in 0.089553 second(s), 15 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表