求助抓取新浪行情

yrystlt

YZC51 发表于 2016-10-4 17:18
FenLie
修改为
Call FenLie

您好！
我抓到的网址“http://ewealth.abchina.com/app/data/api/DataService/GoldInfoV2”一打开就是下载JSON文件，怎么办？

yrystlt

YZC51 发表于 2016-9-20 10:58
找到原因啦！添加XML引用即可，3.0、4.0、5.0、6.0都行！

{"Data":{"Table":[{"ProdCode":"Ag(T+D)","CurrentPrice":"4210.00","UpLowDirection":"0","UpLowRate":"-0.38%","SuccessAmount":"4654558","OpenPrice":"4221.00","YesterdayPrice":"4228.00","HighestPrice":"4245.00","LowestPrice":"4190.00","Kind":"001DZYH","UpdateTime":"2016-09-30 15:45:00","ShowOrder":"1","BuyUrl":"http://ewealth.abchina.com/Gold/client/201501/t20150109_661266.htm"},{"ProdCode":"Au(T+D)","CurrentPrice":"284.80","UpLowDirection":"0","UpLowRate":"0.09%","SuccessAmount":"48292","OpenPrice":"283.92","YesterdayPrice":"284.38","HighestPrice":"284.94","LowestPrice":"283.20","Kind":"001DZYH","UpdateTime":"2016-09-30 15:45:00","ShowOrder":"2","BuyUrl":"http://ewealth.abchina.com/Gold/client/201501/t20150109_661266.htm"},{"ProdCode":"Au(T+N1)","CurrentPrice":"286.25","UpLowDirection":"0","UpLowRate":"-0.43%","SuccessAmount":"80366","OpenPrice":"287.50","YesterdayPrice":"287.55","HighestPrice":"287.90","LowestPrice":"286.25","Kind":"001DZYH","UpdateTime":"2016-09-30 15:45:00","ShowOrder":"3","BuyUrl":"http://ewealth.abchina.com/Gold/client/201501/t20150109_661266.htm"},{"ProdCode":"Au(T+N2)","CurrentPrice":"284.90","UpLowDirection":"0","UpLowRate":"0.04%","SuccessAmount":"82000","OpenPrice":"284.30","YesterdayPrice":"284.65","HighestPrice":"286.50","LowestPrice":"284.10","Kind":"001DZYH","UpdateTime":"2016-09-30 15:45:00","ShowOrder":"4","BuyUrl":"http://ewealth.abchina.com/Gold/client/201501/t20150109_661266.htm"},{"ProdCode":"mAu(T+D)","CurrentPrice":"284.99","UpLowDirection":"0","UpLowRate":"0.09%","SuccessAmount":"44768","OpenPrice":"284.11","YesterdayPrice":"284.51","HighestPrice":"285.05","LowestPrice":"283.50","Kind":"001DZYH","UpdateTime":"2016-09-30 15:45:00","ShowOrder":"5","BuyUrl":"http://ewealth.abchina.com/Gold/client/201501/t20150109_661266.htm"},{"ProdCode":"Au100g","CurrentPrice":"285.00","UpLowDirection":"0","UpLowRate":"0.18%","SuccessAmount":"162","OpenPrice":"284.50","YesterdayPrice":"284.50","HighestPrice":"286.49","LowestPrice":"284.50","Kind":"002DZYH","UpdateTime":"2016-09-30 15:45:00","ShowOrder":"6","BuyUrl":"http://ewealth.abchina.com/Gold/client/201501/t20150109_661266.htm"},{"ProdCode":"Au99.95","CurrentPrice":"284.69","UpLowDirection":"0","UpLowRate":"0.30%","SuccessAmount":"1490","OpenPrice":"284.00","YesterdayPrice":"283.84","HighestPrice":"285.00","LowestPrice":"283.80","Kind":"002DZYH","UpdateTime":"2016-09-30 15:45:00","ShowOrder":"7","BuyUrl":"http://ewealth.abchina.com/Gold/client/201501/t20150109_661266.htm"},{"ProdCode":"Au99.99","CurrentPrice":"284.95","UpLowDirection":"0","UpLowRate":"0.14%","SuccessAmount":"833860","OpenPrice":"284.99","YesterdayPrice":"284.54","HighestPrice":"285.20","LowestPrice":"283.01","Kind":"002DZYH","UpdateTime":"2016-09-30 15:45:00","ShowOrder":"8","BuyUrl":"http://ewealth.abchina.com/Gold/client/201501/t20150109_661266.htm"}],"Table1":[{"ProdCode":"9101","ProdName":"人民币账户黄金","UpLowDirection":"0","CustomerSell":"272.79","CustomerBuy":"273.29","LowSell":"271.44","HighBuy":"274.22","UpdateTime":"2016-10-05 20:13:40","ShowOrder":"1","BasePrice":"273.960000","CurrentPrice":"273.040000","BuyUrl":""},{"ProdCode":"9201","ProdName":"人民币账户白银","UpLowDirection":"0","CustomerSell":"3.82","CustomerBuy":"3.84","LowSell":"3.79","HighBuy":"3.89","UpdateTime":"2016-10-05 20:13:38","ShowOrder":"2","BasePrice":"3.880000","CurrentPrice":"3.830000","BuyUrl":""},{"ProdCode":"9114","ProdName":"美元账户黄金","UpLowDirection":"0","CustomerSell":"1271.18","CustomerBuy":"1274.18","LowSell":"1265.32","HighBuy":"1278.95","UpdateTime":"2016-10-05 20:13:40","ShowOrder":"3","BasePrice":"1277.400000","CurrentPrice":"1272.680000","BuyUrl":""},{"ProdCode":"9214","ProdName":"美元账户白银","UpLowDirection":"0","CustomerSell":"17.79","CustomerBuy":"17.94","LowSell":"17.65","HighBuy":"18.17","UpdateTime":"2016-10-05 20:13:38","ShowOrder":"4","BasePrice":"18.085000","CurrentPrice":"17.865000","BuyUrl":""}]},"ErrorCode":"0","ErrorMsg":"","Url":null}

这是得到的JSON，可以帮我解释一下吗，我用For Each aa1 In CallByName(objJSON, "Date", VbGet)
来循环，老是报错。。。。

五指山888

YZC51 发表于 2016-10-4 17:18
FenLie
修改为
Call FenLie

谢谢老师，FenLie上面一行 Range("b2:b" & (UBound(arr) + 2)) = Application.Transpose(arr)就卡住了

五指山888

002837        英维克，过了节买吧
给关心本贴的各位推荐，第一次，建议各位关注一下，不必实际买入，免得不必要损失。

五指山888

五指山888 发表于 2016-10-26 19:31
谢谢老师，FenLie上面一行 Range("b2:b" & (UBound(arr) + 2)) = Application.Transpose(arr)就卡住了

能不能帮忙解决吗，为啥卡住了

五指山888

YZC51 发表于 2016-9-18 16:27
附件如下：

为啥这个软件不能在2003版下运行？请老师们出手帮下忙解决吧

YZC51

五指山888 发表于 2017-9-16 22:27
为啥这个软件不能在2003版下运行？请老师们出手帮下忙解决吧

来啦
Sub 沪深A股3()
    URL = "http://hqdigi2.eastmoney.com/EM_Quote2010NumericApplication/index.aspx?type=s&sortType=C&sortRule=-1&pageSize=3500&page=1&jsName=quote_123&style=33&_g=" ' & Rnd()
    With CreateObject("Msxml2.XMLHTTP") 'CreateObject("Microsoft.XMLHTTP")
            .Open "GET", URL, False
            .Send
            v = .responseText
    End With
   
    strText = Split(Split(v, "[""")(1), """]")(0)
   
    Cells.ClearContents
    Dim ar() As String
   
    ar = Split(strText, """,""")
    Dim arr(0 To 10000, 0)
    For i = 0 To UBound(ar)
        arr(i, 0) = ar(i)
    Next
    Range("b2:b" & (UBound(arr) + 2)) = arr
    Call FenLie
    [a2] = 1: [a3] = 2: [a2:a3].AutoFill Range("a2:a" & UBound(ar) + 2)
    [a1:AA1] = Split("序号 代码 名称 昨收 今开 最新价 最高 最低 金额 总手 涨跌额 涨跌幅 均价 振幅% 委比% 委差 现手   量比 换手% 市盈率 买入 更新时间 流通股本 流通市值 流通市值")
End Sub

YZC51

或者这样
Sub 沪深A股()
    URL = 同上
    With CreateObject("Msxml2.XMLHTTP") 'CreateObject("Microsoft.XMLHTTP")
            .Open "GET", URL, False
            .Send
            v = .responseText
    End With
   
    strText = Replace(Replace(Split(Split(v, "[""")(1), """]")(0), """,""", "||"), ",", vbTab)
   
    Cells.ClearContents
   
    Dim arr() As String
    arr = Split(strText, "||")
    [a2] = 1: [a3] = 2: [a2:a3].AutoFill Range("a2:a" & UBound(arr) + 2)
    [a1:AA1] = Split("序号 代码 名称 昨收 今开 最新价 最高 最低 金额 总手 涨跌额 涨跌幅 均价 振幅% 委比% 委差 现手   量比 换手% 市盈率 买入 更新时间 流通股本 流通市值 流通市值")
    Call XieRu(arr, [b2])

End Sub

Public Sub XieRu(a, R As Range)
'a：待写入数组；R：写入起始位置
Dim d As Object
Set d = New DataObject
d.SetText Join(a, vbLf)
d.PutInClipboard
R.Select
ActiveSheet.Paste
Set d = Nothing
End Sub

YZC51

DataObject 要引用microsort forms 2.0，增加一个窗体就自动引用了。没有引用是出现未定义类型！

YZC51

请看附件
沪深A股.rar (17.16 KB, 下载次数: 61)

2017-9-18 22:31 上传

点击文件名下载附件