求助:如何抓取东方财富财经日历数据

phsu · 发表于 2017-10-5 18:15

Sub 財富財經日曆財經會議數據()
   Dim JsStr As String
   Dim Js As String
   Dim tmpStr As String
   Dim i As Integer
   Dim nPage As Byte
   Dim nRow As Integer

   ThisWorkbook.ActiveSheet.Cells.Clear
   JsStr = "http://data.eastmoney.com/DataCenter_V3/cjrl/getData.ashx?&pagesize=50&page=1&js=var o&sortRule=1&sortType=ConferenceDate&startDateTime=2017-10-02&endDateTime=2017-10-31&Type=cjhy&rt=50239938"
   With CreateObject("WinHttp.WinHttpRequest.5.1")
      .Open "GET", JsStr, False
      .setrequestheader "Referer", "http://data.eastmoney.com/cjrl/default.html"
      .send
      JsStr = .responsetext
   End With
   tmpStr = JsStr & ";"
   With CreateObject("MSScriptControl.ScriptControl")
      .Language = "JScript"
      .addcode tmpStr
      nPage = .Eval("o.pages")
   End With
   nRow = 0
   For i = 1 To nPage
      JsStr = "http://data.eastmoney.com/DataCenter_V3/cjrl/getData.ashx?&pagesize=50&page=" & i & "&js=var o&sortRule=1&sortType=ConferenceDate&startDateTime=2017-10-02&endDateTime=2017-10-31&Type=cjhy&rt=50239938"
      With CreateObject("WinHttp.WinHttpRequest.5.1")
         .Open "GET", JsStr, False
         .setrequestheader "Referer", "http://data.eastmoney.com/cjrl/default.html"
         .send
         JsStr = .responsetext
      End With
      Js = "var r,k,row=c=1,d={};for(r in j){row++;for(k in j[r]){if(!d[k]){d[k]=c++;rng(1,d[k])=k;}rng(row,d[k])= j[r][k];}}"
      Js = "j=" & Split(Split(JsStr, "data"":")(1), "]")(0) & "]" & ";" & Js
      With CreateObject("MSScriptControl.ScriptControl")
         .Language = "JScript"
         .AddObject "rng", ThisWorkbook.ActiveSheet.Range("A" & nRow + 1)
         .Eval (Js)
      End With
      If i <> 1 Then
         With ThisWorkbook.ActiveSheet
               .Rows(nRow + 1).Delete
               nRow = .Range("A65536").End(xlUp).Row
         End With
      Else
         nRow = ThisWorkbook.ActiveSheet.Range("A65536").End(xlUp).Row
      End If
   Next i
   ThisWorkbook.ActiveSheet.Columns("A:R").AutoFit
End Sub

五指山888 · 发表于 2017-10-5 22:33

phsu 发表于 2017-10-5 18:15
Sub 財富財經日曆財經會議數據()
Dim JsStr As String
Dim Js As String

谢谢phsu老师，财经会议数据能抓去了，我运行下来，不知道为啥9月不能运行抓取？我对照了查不出原因，请老师能看一下吗？运行到这句 .Eval (Js) '此处卡住
Sub 东财日历phsu财经修改版9()
   Dim JsStr As String
   Dim Js As String
   Dim tmpStr As String
   Dim i As Integer
   Dim nPage As Byte
   Dim nRow As Integer

   ThisWorkbook.ActiveSheet.Cells.Clear
   JsStr = "http://data.eastmoney.com/DataCenter_V3/cjrl/getData.ashx?&pagesize=50&page=1&js=var o&sortRule=1&sortType=ConferenceDate&startDateTime=2017-09-01&endDateTime=2017-09-30&Type=cjhy&rt=50239938"
   With CreateObject("WinHttp.WinHttpRequest.5.1")
      .Open "GET", JsStr, False
      .setrequestheader "Referer", "http://data.eastmoney.com/cjrl/default.html"
      .send
      JsStr = .responsetext
   End With
   tmpStr = JsStr & ";"
   With CreateObject("MSScriptControl.ScriptControl")
      .Language = "JScript"
      .addcode tmpStr
      nPage = .Eval("o.pages")
   End With
   nRow = 0
   For i = 1 To nPage
      JsStr = "http://data.eastmoney.com/DataCenter_V3/cjrl/getData.ashx?&pagesize=50&page=" & i & "&js=var o&sortRule=1&sortType=ConferenceDate&startDateTime=2017-09-01&endDateTime=2017-09-30&Type=cjhy&rt=50239938"
      With CreateObject("WinHttp.WinHttpRequest.5.1")
         .Open "GET", JsStr, False
         .setrequestheader "Referer", "http://data.eastmoney.com/cjrl/default.html"
         .send
         JsStr = .responsetext
      End With
      Js = "var r,k,row=c=1,d={};for(r in j){row++;for(k in j[r]){if(!d[k]){d[k]=c++;rng(1,d[k])=k;}rng(row,d[k])= j[r][k];}}"
      Js = "j=" & Split(Split(JsStr, "data"":")(1), "]")(0) & "]" & ";" & Js
      With CreateObject("MSScriptControl.ScriptControl")
         .Language = "JScript"
         .AddObject "rng", ThisWorkbook.ActiveSheet.Range("A" & nRow + 1)
         .Eval (Js) '此处卡住
      End With
      If i <> 1 Then
         With ThisWorkbook.ActiveSheet
               .Rows(nRow + 1).Delete
               nRow = .Range("A65536").End(xlUp).Row
         End With
      Else
         nRow = ThisWorkbook.ActiveSheet.Range("A65536").End(xlUp).Row
      End If
   Next i
   ThisWorkbook.ActiveSheet.Columns("A:R").AutoFit
   'dfrl格式整理
End Sub

kings12333 · 发表于 2017-10-6 09:07

五指山888 发表于 2017-10-5 22:33
谢谢phsu老师，财经会议数据能抓去了，我运行下来，不知道为啥9月不能运行抓取？我对照了查不出原因，请 ...

改下HTTP地址中的日期试试

五指山888 · 发表于 2017-10-6 10:44

请老师能看一下吗？为啥除了10月份，其他月份都会卡住

五指山888 · 发表于 2017-10-6 10:47

kings12333 发表于 2017-10-6 09:07
改下HTTP地址中的日期试试

谢谢能常来建楼，希望更多的能人来关注

kings12333 · 发表于 2017-10-6 10:55

phsu 发表于 2017-10-5 18:15
Sub 財富財經日曆財經會議數據()
Dim JsStr As String
Dim Js As String

不明白这段是啥意思，前面已经Get一次数据，后面为何还要Get 一次。。

   JsStr = "http://data.eastmoney.com/DataCenter_V3/cjrl/getData.ashx?&pagesize=50&page=" & i & "&js=var o&sortRule=1&sortType=ConferenceDate&startDateTime=2017-10-02&endDateTime=2017-10-31&Type=cjhy&rt=50239938"
      With CreateObject("WinHttp.WinHttpRequest.5.1")
         .Open "GET", JsStr, False
         .setrequestheader "Referer", "http://data.eastmoney.com/cjrl/default.html"
         .send
         JsStr = .responsetext
      End With

phsu · 发表于 2017-10-6 12:32

五指山888 发表于 2017-10-6 10:44
请老师能看一下吗？为啥除了10月份，其他月份都会卡住

Sub 財富財經日曆財經會議數據()
   Dim JsStr As String
   Dim Js As String
   Dim tmpStr As String
   Dim i As Integer
   Dim nPage As Byte
   Dim nRow As Integer

   ThisWorkbook.ActiveSheet.Cells.Clear
   JsStr = "http://data.eastmoney.com/DataCenter_V3/cjrl/getData.ashx?&pagesize=50&page=1&js=var o&sortRule=1&sortType=ConferenceDate&startDateTime=2017-09-01&endDateTime=2017-09-29&Type=cjhy&rt=50239938"
   With CreateObject("WinHttp.WinHttpRequest.5.1")
      .Open "GET", JsStr, False
      .setrequestheader "Referer", "http://data.eastmoney.com/cjrl/default.html"
      .send
      JsStr = .responsetext
   End With
   tmpStr = JsStr & ";"
   With CreateObject("MSScriptControl.ScriptControl")
      .Language = "JScript"
      .addcode tmpStr
      nPage = .Eval("o.pages")
   End With
   nRow = 0
   For i = 1 To nPage
      JsStr = "http://data.eastmoney.com/DataCenter_V3/cjrl/getData.ashx?&pagesize=50&page=" & i & "&js=var o&sortRule=1&sortType=ConferenceDate&startDateTime=2017-09-01&endDateTime=2017-09-29&Type=cjhy&rt=50239938"
      With CreateObject("WinHttp.WinHttpRequest.5.1")
         .Open "GET", JsStr, False
         .setrequestheader "Referer", "http://data.eastmoney.com/cjrl/default.html"
         .send
         JsStr = .responsetext
      End With
      Js = "var r,k,row=c=1,d={};for(r in j){row++;for(k in j[r]){if(!d[k]){d[k]=c++;rng(1,d[k])=k;}rng(row,d[k])= j[r][k];}}"
      Js = "j=" & Split(Split(JsStr, "data"":")(1), "}]")(0) & "}]" & ";" & Js
      With CreateObject("MSScriptControl.ScriptControl")
         .Language = "JScript"
         .AddObject "rng", ThisWorkbook.ActiveSheet.Range("A" & nRow + 1)
         .Eval (Js)
      End With
      If i <> 1 Then
         With ThisWorkbook.ActiveSheet
               .Rows(nRow + 1).Delete
               nRow = .Range("A65536").End(xlUp).Row
         End With
      Else
         nRow = ThisWorkbook.ActiveSheet.Range("A65536").End(xlUp).Row
      End If
   Next i
   ThisWorkbook.ActiveSheet.Columns("A:R").AutoFit
End Sub

phsu · 发表于 2017-10-6 13:12

kings12333 发表于 2017-10-6 10:55
不明白这段是啥意思，前面已经Get一次数据，后面为何还要Get 一次。。

第一次GET用來擷取總頁數，以決定循環次數。後面用循環GET每頁的資料。

五指山888 · 发表于 2017-10-6 13:20

phsu 发表于 2017-10-6 13:12
第一次GET用來擷取總頁數，以決定循環次數。後面用循環GET每頁的資料。

谢谢老师，我试了8,9月份都可以了，您改在哪儿？我还没来得及看，先谢谢老师了

kings12333 · 发表于 2017-10-6 14:14

phsu 发表于 2017-10-6 13:12
第一次GET用來擷取總頁數，以決定循環次數。後面用循環GET每頁的資料。

能否改成数据不用单元格显示，直接用LISTBOX或LISTVIEW控件来显示呢。。

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

[求助] 求助:如何抓取东方财富财经日历数据

评分