[已解决](未解决,求管理别再改主题分类)(原来代码已失效，再求助)从网页提取数据不成功，跪求

staynam

雪舞子 发表于 2017-6-7 12:50
你把网址最重要部分丢掉了，不错都难。
在14楼网址上点右键，复制链接地址，
然后代入 “sd”、“ed” ...

好像是可以了。万分感谢大佬。

staynam

雪舞子 发表于 2017-6-7 12:50
你把网址最重要部分丢掉了，不错都难。
在14楼网址上点右键，复制链接地址，
然后代入 “sd”、“ed” ...

大大您好，您之前给的代码突然不能用了，但是我用httpfox嗅探地址发现真实地址并未改变，跪求帮忙。

运行的时候出现如下错误

然后点击调试会跳到         .send    这一行
跪求大大帮忙

其中一个代码如下（因为论坛等级不能发链接，所以我把 url= 后面的 http:// 去掉了）

1. Sub test_1()
   
2.     Dim url$, strJSON$, objJson, rData
   
3.     Dim ar, brr(1000, 30), i%, j%
   
4.     url = "fund.eastmoney.com/data/rankhandler.aspx?op=ph&dt=kf&ft=qdii&rs=&gs=0&sc=1yzf&st=desc&qdii=&tabSubtype=,,,,,&pi=1&pn=51"
   
5.     With CreateObject("msxml2.xmlhttp")
   
6.         .Open "GET", url, False
   
7.         .send
   
8.         strJSON = .responsetext
   
9.     End With
   
10.     With CreateObject("msscriptcontrol.scriptcontrol")
    
11.         .Language = "JavaScript"
    
12.         .AddCode strJSON
    
13.         Set objJson = .CodeObject
    
14.     End With
    
15.     For Each rData In objJson.rankData.datas
    
16.         i = i + 1
    
17.         ar = Split(rData, ",")
    
18.         For j = 0 To UBound(ar)
    
19.             brr(i, j) = ar(j)
    
20.         Next
    
21.     Next
    
22.     Cells.Clear
    
23.     Cells.Font.Size = 9
    
24.     [a:a].NumberFormatLocal = "@"
    
25.     [a1].Resize(i, UBound(ar)) = brr
    
26.     MsgBox "抓取完毕！"
    
27. End Sub

复制代码