ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: onlycxb

[分享] 东方财富网天天练

  [复制链接]

TA的精华主题

TA的得分主题

发表于 2015-3-10 22:54 | 显示全部楼层
按照您的代码,多页取值,就会发现某些页面会出现“403“禁止访问提示。。。。
Sub t()
    Dim html, db, i%, j%, k%, rowx, TD, TR, arrdata(1 To 10000, 1 To 18)
    Set html = CreateObject("htmlfile")
    For k = 1 To 100
        With CreateObject("msxml2.xmlhttp")
            .Open "GET", "http://data.eastmoney.com/bbsj/201412/yjyg/" & k & ".html", False  '以取第1页数据为例
            .send
                        Do Until .readyState = 4
                             DoEvents
                        Loop
                        If .Status <> 200 Then
                            If r < 10 Then
                                 r = r + 1
                            Else
                                  MsgBox "无法打开东方财富网数据中心指定网页" & vbCrLf & vbCrLf & "http://data.eastmoney.com/bbsj/201412/yjyg/" & k & ".html" & vbCrLf & vbCrLf & "Http状态:" & .Status
                                  End
                            End If
                        End If
        End With
    Next
End Sub

大神请出手相助!!!

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-3-10 23:22 | 显示全部楼层
本帖最后由 onlycxb 于 2015-3-11 08:32 编辑
mckawayi 发表于 2015-3-10 22:54
按照您的代码,多页取值,就会发现某些页面会出现“403“禁止访问提示。。。。
Sub t()
    Dim html, db ...

简单测试一下(代码未优化),运行1000次没有出错
  1. Option Explicit

  2. Sub t()
  3.     Dim html, db, i%, j%, k%, rowx, TD, TR, arrdata(1 To 100000, 1 To 18), P
  4.    
  5.     For P = 1 To 1000
  6.     Set html = CreateObject("htmlfile")
  7.     With CreateObject("msxml2.xmlhttp")
  8.         .Open "GET", "http://data.eastmoney.com/bbsj/201412/yjbb/ggrq/desc/" & P & ".html", False '以取第1页数据为例
  9.         .send
  10.         html.body.innerhtml = .responsetext
  11.     End With

  12.     Set db = html.all.tags("table")
  13.     For i = 0 To db.Length - 1
  14.         If db(i).classname = "tab1" Then
  15.             Set rowx = db(i).Rows
  16.             For Each TR In rowx
  17.                 j = j + 1
  18.                 k = 0
  19.                 For Each TD In TR.Cells
  20.                      k = k + 1
  21.                 If j > 2 Then arrdata(j - 2, k) = TD.innertext
  22.                 Next TD
  23.             Next TR
  24.         End If
  25.     Next i
  26.     Set html = Nothing
  27.     Set db = Nothing
  28.     Set rowx = Nothing
  29.     Next P
  30.     Cells.Clear
  31.     [a1].Resize(j - 2, 18) = arrdata
  32. End Sub
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-3-11 08:31 | 显示全部楼层
10.东方财富网股票的财务分析数据更新入EXCEL工作表的VBA代码  网页:http://f10.eastmoney.com/f10_v2/ ... .aspx?code=sz000898
  1. Sub t()
  2.     Dim html, db, i%, j%, k%, tr, td, arr(1 To 100000, 1 To 10)
  3.     Set html = CreateObject("htmlfile")
  4.     With CreateObject("msxml2.xmlhttp")
  5.         .Open "GET", "http://f10.eastmoney.com/f10_v2/FinanceAnalysis.aspx?code=sz000898 ", False
  6.         .send
  7.         html.write .responsetext
  8.     End With
  9.     Set db = html.all.tags("table")
  10.     For i = 0 To db.Length - 1
  11.         If db(i).classname = "needScroll" Or db(i).ID = "BBMX_table" Then
  12.             For Each tr In db(i).Rows
  13.                 j = j + 1
  14.                 k = 0
  15.                 For Each td In tr.Cells
  16.                     k = k + 1
  17.                     arr(j, k) = td.innertext
  18.                 Next td
  19.             Next tr
  20.         End If
  21.     Next i
  22.     [a1].Resize(j, k) = arr
  23. End Sub
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2015-3-11 14:56 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
onlycxb 发表于 2015-3-10 07:46
6.外汇行情

7楼第12句循环代码中的i是否应该改为n或其他非i变量?——这样方可获取六大银行(中国银行、农业银行、工商银行、建设银行、交通银行、招商银行)的外汇行情数据,否则只能获取中国银行的外汇行情数据:
  1. Sub 更新外汇行情数据2()
  2. Dim html As Object, arrdata(1 To 100000, 1 To 8), Db, Url$
  3.     Dim i%, j%, tr, td
  4.     Url = "http://quote.eastmoney.com/center/forexlist.html"
  5.     Set html = CreateObject("htmlfile")
  6.     With CreateObject("msxml2.xmlhttp")
  7.         .Open "GET", Url, False
  8.         .send
  9.         html.body.innerhtml = StrConv(.ResponseBody, vbUnicode, &H804)
  10.     End With
  11.     Set Db = html.all.tags("table")
  12.     For n = 0 To Db.Length - 1
  13.         If Db(n).classname = "data-table" Then
  14.             arrdata(n + i + 1, 1) = html.all.tags("ul")("yhpj").ChildNodes(n).innertext
  15.             For Each tr In Db(n).Rows
  16.                 i = i + 1
  17.                 j = 0
  18.                 For Each td In tr.Cells
  19.                     j = j + 1
  20.                     arrdata(n + i + 1, j) = td.innertext
  21.                 Next td
  22.             Next tr
  23.         End If
  24.     Next
  25.     Cells.Clear
  26.     [a1].Resize(i, UBound(arrdata, 2)) = arrdata
  27. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2015-3-11 15:10 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 VBA万岁 于 2015-3-13 10:04 编辑
VBA万岁 发表于 2015-3-11 14:56
7楼第12句循环代码中的i是否应该改为n或其他非i变量?——这样方可获取六大银行(中国银行、农业银行、工 ...


附件:
提取银行外汇行情数据.zip (76.95 KB, 下载次数: 274)

TA的精华主题

TA的得分主题

发表于 2015-3-12 09:43 | 显示全部楼层
本帖最后由 mckawayi 于 2015-3-12 09:54 编辑

Option Explicit

Sub t()
    Dim html, db, i%, j%, k%, rowx, TD, TR, arrdata(1 To 100000, 1 To 18), P
   
    For P = 1 To 1000
    Set html = CreateObject("htmlfile")
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", "http://data.eastmoney.com/bbsj/201412/yjbb/ggrq/desc/" & P & ".html", False '以取第1页数据为例
        .send
            Do Until .readyState = 4
                 DoEvents
            Loop
            If .Status <> 200 Then
                      MsgBox "无法打开东方财富网数据中心指定网页" & vbCrLf & vbCrLf &
"http://data.eastmoney.com/bbsj/201412/yjbb/ggrq/desc/" & P & ".html" & vbCrLf & vbCrLf & "Http状态:" & .Status
                      End
            End If

        html.body.innerhtml = .responsetext
    End With

    Set db = html.all.tags("table")
    For i = 0 To db.Length - 1
        If db(i).classname = "tab1" Then
            Set rowx = db(i).Rows
            For Each TR In rowx
                j = j + 1
                k = 0
                For Each TD In TR.Cells
                     k = k + 1
                If j > 2 Then arrdata(j - 2, k) = TD.innertext
                Next TD
            Next TR
        End If
    Next i
    Set html = Nothing
    Set db = Nothing
    Set rowx = Nothing
    Next P
    Cells.Clear
    [a1].Resize(j - 2, 18) = arrdata
End Sub

大神,只要在您的代码中加入红色部分,就会发现某些页面会出现“403禁止访问”提示!
遍历提取业绩预告数据,访问页面http://data.eastmoney.com/bbsj/201503/yjyg/P.html时某些页面也会出现相同“禁止访问”提示!
遍历股票提取龙虎榜数据时,访问页面[url=http://data.eastmoney.com/stock/lhb/xxxxxx.html]http://data.eastmoney.com/stock/lhb/xxxxxx.html时某些页面也会出现相同“禁止访问”提示!

禁止访问了,后续数据提取自然就无法完成。。。倘若这个问题不解决,从东方财富网提取数据就变得极不可靠了。
Http头信息有cookie内容,是否因为这些页面有防盗链而无法正常访问?请大神相助!

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-3-12 16:38 | 显示全部楼层
本帖最后由 onlycxb 于 2015-3-12 16:40 编辑
mckawayi 发表于 2015-3-12 09:43
Option Explicit

Sub t()

1.readyState是Ie属性。想想用这里合适吗?
2.没有cookie,已经取出数据,还有必要吗?

TA的精华主题

TA的得分主题

发表于 2015-3-15 13:51 | 显示全部楼层
本帖最后由 mckawayi 于 2015-3-15 17:46 编辑
onlycxb 发表于 2015-3-12 16:38
1.readyState是Ie属性。想想用这里合适吗?
2.没有cookie,已经取出数据,还有必要吗?

Option Explicit

Sub t()
    Dim html, db, i%, j%, k%, rowx, TD, TR, arrdata(1 To 100000, 1 To 18), P
   
    For P = 1 To 37
    Set html = CreateObject("htmlfile")
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", "http://data.eastmoney.com/bbsj/201412/yjyg/ & P & ".html", False '以取第1页数据为例
        .send
            If .Status <> 200 Then
                      MsgBox  "Http状态:" & .Status
                      End
            End If
       'html.body.innerhtml = .responsetext
    End With
Next P

End Sub

即使去掉readystate语句,某些页面依然禁止访问。。。

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-3-15 18:54 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
具体不清,有可能同一IP地址发送请求过多,遭到服务器智能屏蔽

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-3-25 08:42 | 显示全部楼层
11、东方财富网 > 数据中心 > 年报季报 > 预约时间
2014年年报业绩大全                               

个股业绩报表:
  1. Sub test()
  2.      Cells.Clear
  3.      For p = 1 To 3
  4.          Set s = IIf(p = 1, Cells(Rows.Count, 1).End(xlUp), Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
  5.          With ActiveSheet.QueryTables.Add(Connection:="URL;http://data.eastmoney.com/bbsj/201412/yysj/sc/asc/" & p & ".html", Destination:=s)
  6.              .Refresh BackgroundQuery:=False
  7.          End With
  8.          If p > 1 Then s.EntireRow.Delete
  9.      Next p
  10. End Sub
  11.   
复制代码

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 04:01 , Processed in 0.054513 second(s), 11 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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