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

五指山888

求助:如何抓取东方财富财经日历数据，并且按上传文件1-4行的格式排列，如果有困难，希望开始日期能分列出来。谢谢！
财经日历 _ 数据中心 _ 东方财富网
http://data.eastmoney.com/cjrl/default.html

phsu

(1)請人協助網抓卻不提供網址，有點奇怪。
(2)我發覺你經常尋求網抓的協助。應該是有很多這方面的需求。若是這樣，應該試著學習網抓，而非到處伸手要代碼。通常，試著寫代碼之後再尋求協助，會比較容易獲得回應。

五指山888

phsu 发表于 2017-10-4 09:28
(1)請人協助網抓卻不提供網址，有點奇怪。
(2)我發覺你經常尋求網抓的協助。應該是有很多這方面的需求。若 ...

谢谢指教和指正！问题是连这个也打不开C:\Documents and Settings\Administrator\Local Settings\Temporary Internet Files，都是加锁的，实在太菜了。hqdigi2.eastmoney.com/EM_Quote2010NumericApplication/index.aspx?type=s&sortType=C&sortRule=-1&pageSize=5000&page=1&jsName=quote_123&style=33&_g=" & Rnd(), False
http://hqdigi2.eastmoney.com/EM_ ... g=%22%20&%20Rnd(),%20False这个网址如何都到？网上有方法，但不会用

Kaohsing

fiddle或者httpwatch抓包。

五指山888

Kaohsing 发表于 2017-10-4 18:10
fiddle或者httpwatch抓包。

谢谢提示，可ycz51老师提供了网址，运行不能通过
With CreateObject("Msxml2.XMLHTTP") 'CreateObject("Microsoft.XMLHTTP")
    .Open "GET", "http://data.eastmoney.com/DataCenter_V3/cjrl/getData.ashx?&pagesize=50&page=2&js=var%20brqVJlBI&param=&sortRule=1&sortType=ConferenceDate&code=&startDateTime=2017-10-04&endDateTime=2017-10-30&Type=all&rt=50236297" & Rnd(), False
    .Send
    v = .ResponseText
End With
    strText = Split(Split(v, "[""")(1), """]")(0) '卡住了？
   Cells.ClearContents '
    Dim crr() As String
    crr = Split(strText, """,""")
   
  [A1].Resize(1, 12) = Split("序号 时间 名称 主办单位 地区 类型 相关板块 相关个股 详细 开始日期 结束日期 股票代码")
For i = 0 To UBound(crr)
    brr = Split(crr(i), ",")
  [a2].Resize(1, 12).Offset(i, 0) = brr '
Next

strText = Split(Split(v, "[""")(1), """]")(0) '这句卡住了，不知如何弄

phsu

以下程式可擷取10月2日至10月31日的資料。
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=all&rt=50237291"
    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=all&rt=50237291"
        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

jinsha2002

以下程式可擷取10月2日至10月31日的資料。
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=all&rt=50237291"
    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=all&rt=50237291"
        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

YZC51

请看附件
财经日历-解析等.rar (80.16 KB, 下载次数: 104)

2017-10-5 00:01 上传

点击文件名下载附件

Kaohsing

五指山888 发表于 2017-10-4 19:10
谢谢提示，可ycz51老师提供了网址，运行不能通过
With CreateObject("Msxml2.XMLHTTP") 'CreateObject(" ...

东方财富网返回的数据大部分都是json格式，该网页也不例外。 Split(Split(v, "[""")(1), """]")(0) '使用split切割成大体的取值范围，以配合下面的split嵌套进行精细切割最终获得数据。strText = Split(Split(v, "[""")(1), """]")(0) '这句卡住了，大概是, "["""这个分解点不唯一，而其中又不含有““]””字符，所以报错。以上只是自己的一点理解，仅供参考。

kings12333

jinsha2002 发表于 2017-10-4 21:43
以下程式可擷取10月2日至10月31日的資料。
Sub 財富財經日曆數據()
    Dim JsStr As String

数据可取到，但感觉不全，能不能避开只要中国股市的数据，有些代表股未提取到数据