东方财富网天天练

onlycxb · 发表于 2015-3-9 16:31

本帖最后由 onlycxb 于 2015-3-10 13:40 编辑

1.东方财富_开发式基金净值

Sub 东方财富_开发式基金净值()
Dim js As Object, arr, db
Set js = CreateObject("scriptcontrol")
js.Language = "jscript"
With CreateObject("msxml2.xmlhttp")
.Open "GET", "http://fund.eastmoney.com/Data/Fund_JJJZ_Data.aspx?t=1&lx=1&letter=&gsid=&text=&sort=zdf,desc&page=1,9999&dt=1425889193593&atfc=&onlySale=0", False
.send
js.addcode .ResponseText
End With
For Each db In js.eval("db.datas")
Debug.Print db '这里输出数据
Next db
End Sub

复制代码

补充内容 (2015-6-3 08:24):
以上为示例代码，请自行完善。

onlycxb · 发表于 2015-3-9 17:04

2.东方财富_货币型基金每日收益一览表

Sub 东方财富_货币型基金每日收益一览表()
Dim html As Object, arr, db, Tr, Td, i, j
Dim arrData(1 To 10000, 1 To 11)
Set html = CreateObject("htmlfile")
With CreateObject("msxml2.xmlhttp")
.Open "GET", "http://fund.eastmoney.com/HBJJ_dwsy.html", False
.send
html.write StrConv(.Responsebody, vbUnicode)
End With
Set db = html.all.tags("table")("oTable")
Cells.Clear
For Each Tr In db.Rows
i = i + 1
j = 0
For Each Td In Tr.Cells
j = j + 1
If i > 2 And j > 2 Then arrData(i - 2, j - 2) = Td.innerText '从第三行,第三列开始取数据
Next
Next
ActiveSheet.[a1].Resize(i - 3, j - 2) = arrData
End Sub

复制代码

onlycxb · 发表于 2015-3-9 17:09

Sub 东方财富_货币型基金每日收益一览表2()
Dim html As Object, arr, db, Tr, Td, i, j
Dim arrData(1 To 10000, 1 To 11)
Set html = CreateObject("htmlfile")
With CreateObject("msxml2.xmlhttp")
.Open "GET", "http://fund.eastmoney.com/HBJJ_dwsy.html", False
.send
html.write StrConv(.Responsebody, vbUnicode)
End With
Set db = html.all.tags("table")("oTable")
Cells.Clear
For i = 3 To db.Rows.Length - 1
Set Row = db.Rows(i)
For j = 3 To Row.Cells.Length - 1
Cells(i - 2, j - 2) = Row.Cells(j).innerText
Next
Next
End Sub

复制代码

onlycxb · 发表于 2015-3-9 18:38

3.分级基金净值表（方法同开发式基金）

Sub 分级基金净值()
Dim js As Object, arr, db, Url$
Url = "http://fund.eastmoney.com/Data/Fund_JJJZ_Data.aspx?t=1&lx=9&letter=&gsid=0&text=&sort=zdf,desc&page=1,10000000&dt=1425897162484&atfc= "
Set js = CreateObject("scriptcontrol")
js.Language = "jscript"
With CreateObject("msxml2.xmlhttp")
.Open "GET", Url, False
.send
js.addcode .ResponseText
End With
For Each db In js.eval("db.datas")
Debug.Print db '这里输出数据
Next db
End Sub

复制代码

onlycxb · 发表于 2015-3-9 18:44

4.开发基金排名（方法同1、3）

Sub 开发基金排名()
Dim js As Object, db, Url$
Url = "http://fund.eastmoney.com/data/rankhandler.aspx?op=ph&dt=kf&ft=all&rs=&gs=0&sc=zzf&st=desc&sd=2014-03-09&ed=2015-03-09&qdii=&pi=1&pn=10000&dx=1&v=0.8996843082575179"
Set js = CreateObject("scriptcontrol")
js.Language = "jscript"
With CreateObject("msxml2.xmlhttp")
.Open "GET", Url, False
.send
js.addcode .ResponseText
End With
For Each db In js.eval("rankData.datas")
Debug.Print db '这里输出数据
Next db
End Sub

复制代码

onlycxb · 发表于 2015-3-9 19:15

5.新股申购与中签查询

Sub main()
Dim js As Object, arr, Db
Dim i%, j%, Total%
Set js = CreateObject("scriptcontrol")
js.Language = "jscript"
With CreateObject("msxml2.xmlhttp")
.Open "GET", "http://datainterface.eastmoney.com/EM_DataCenter/JS.aspx?type=NS&sty=NSST&st=12&sr=-1&p=1&ps=1&js=(pc),(x)&stat=1&rt=" & Rnd(), False
.send
Total = Split(.responsetext, ",")(0)
.Open "GET", "http://datainterface.eastmoney.com/EM_DataCenter/JS.aspx?type=NS&sty=NSST&st=12&sr=-1&p=1&ps=" & Total & "&js=var%20rxSJdnPK={pages:(pc),data:[(x)]}&stat=1&rt=" & Rnd, False
.send
js.addcode .responsetext
End With
ReDim arr(1 To Total, 1 To 26)
i = 0
For Each Db In js.eval("rxSJdnPK.data")
i = i + 1
For j = 1 To 26
arr(i, j) = Split(Db, ",")(j - 1)
Next j
Next Db
Cells.Clear
[a1].Resize(Total, 26) = arr
End Sub

复制代码

onlycxb · 发表于 2015-3-10 07:46

6.外汇行情

Sub t6()
Dim html As Object, arrdata(1 To 100000, 1 To 8), Db, Url$
Dim i%, j%, tr, td
Url = "http://quote.eastmoney.com/center/forexlist.html"
Set html = CreateObject("htmlfile")
With CreateObject("msxml2.xmlhttp")
.Open "GET", Url, False
.send
html.body.innerhtml = StrConv(.ResponseBody, vbUnicode, &H804)
End With
Set Db = html.all.tags("table")
For i = 0 To Db.Length - 1
If Db(i).classname = "data-table" Then
For Each tr In Db(i).Rows
i = i + 1
j = 0
For Each td In tr.Cells
j = j + 1
arrdata(i, j) = td.innertext
Next td
Next tr
End If
Next
Cells.Clear
[a1].Resize(i, UBound(arrdata, 2)) = arrdata
End Sub

复制代码

mckawayi · 发表于 2015-3-10 13:29

请教大神，东方财富网的业绩数据是否已经加密而不能用xmlhttp方法提取？
前几天以下代码还能运行，现在却总是在j=51的位置报错，禁止访问！
         For j = 1 To 55
      r = 1
restart2:
            With CreateObject("Msxml2.ServerXMLHTTP")
                  .Open "GET", "http://data.eastmoney.com/bbsj/201412/yjbb/ggrq/desc/“ & j & ".html", False
                  .send
                  Do Until .readyState = 4
                     DoEvents
                  Loop
                  If .Status <> 200 Then
                     If r <10 Then
                           r = r + 1
                           GoTo restart2
                     Else
                           MsgBox "无法打开东方财富网数据中心指定网页" & vbCrLf & vbCrLf & "http://data.eastmoney.com/bbsj/" & C1 & C3 & j & ".html" & vbCrLf & vbCrLf & "Http状态：" & .Status
                           End
                     End If
                  End If
               ‘Str_D = StrConv(.responseBody, vbUnicode)
            End With
            ‘str1 = InStr(Str_D, "<tbody>")
            ’str2 = InStr(str1, Str_D, "</tbody>")
            ‘strM = strM & Mid(Str_D, str1 + 7, str2 - str1 - 7)
         Next

下面是http头信息
(Request-Line) GET /bbsj/201409/yjbb/ggrq/desc/2.html HTTP/1.1
Host data.eastmoney.com
User-Agent Mozilla/5.0 (Windows NT 6.1; WOW64; rv:36.0) Gecko/20100101 Firefox/36.0
Accept text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
Accept-Language zh-CN,zh;q=0.8,en-US;q=0.5,en;q=0.3
Accept-Encoding gzip, deflate
Referer http://data.eastmoney.com/bbsj/201409/yjbb.html
Cookie emstat_bc_emcount=1036748195792377156; emstat_ss_emcount=30_1425992997_54967698; pgv_pvi=3715790260; HAList=a-sh-601198-%u4E1C%u5174%u8BC1%u5238%2Ca-sz-300333-%u5146%u65E5%u79D1%u6280%2Ca-sz-000016-%u6DF1%u5EB7%u4F73A%2Ca-sh-600004-%u767D%u4E91%u673A%u573A; em_hq_fls=old; pgv_info=ssi=s8031867592; ASP.NET_SessionId=4q0lsi55erddclfuszzdlc45
Connection keep-alive

貌似有了防盗链？
查到http://club.excelhome.net/thread-899268-1-1.html

可惜不会用，恳请大神示范，多谢！

onlycxb · 发表于 2015-3-10 13:35

7.东方财富网 > 数据中心 > 年报季报 > 业绩报表

Sub t()
Dim html, db, i%, j%, k%, rowx, TD, TR, arrdata(1 To 10000, 1 To 18)
Set html = CreateObject("htmlfile")
With CreateObject("msxml2.xmlhttp")
.Open "GET", "http://data.eastmoney.com/bbsj/201412/yjbb/ggrq/desc/1.html", False '以取第1页数据为例
.send
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
Cells.Clear
[a1].Resize(j - 2, 18) = arrdata
End Sub

复制代码

onlycxb · 发表于 2015-3-10 15:29

mckawayi 发表于 2015-3-10 13:29
请教大神，东方财富网的业绩数据是否已经加密而不能用xmlhttp方法提取？
前几天以下代码还能运行，现在却总 ...

见9楼，我只取了一页

		自动登录	找回密码
密码			免费注册

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

评分