求网址,求寻龙诀资源谢谢!

查看: 565|回复: 8
求助:一个抓取程序改了网址就不能抓取了求高手帮忙,谢谢!
阅读权限20
在线时间 小时
一个抓取程序改了网址就不能抓取了求高手帮忙,谢谢!
Sub test2(t As Integer)
Dim html, tb, i%, j%, r As Long
On Error Resume Next
Set html = CreateObject(&htmlfile&)
With CreateObject(&msxml2.xmlhttp&)
& & .Open &GET&, &file:///C:\Users\ADMINI~1\AppData\Local\Temp\%W@GJ$ACOF(TYDYECOKVDYB.png/data_ndkA0A46A198/& & t & &.html&, False
& & html.body.innerhtml = .ResponseText
& & Set tb = html.all.tags(&table&)(0).Rows
& & s = Range(&a65536&).End(3).Row
& & For i = 1 To tb.Length - 1
& && &&&For j = 0 To tb(i).Cells.Length - 1
& && && && &Cells(i + s, j + 1) = tb(i).Cells(j).innertext
& && &&&Next
Sub 中财行情()
& & Dim i As Integer
Cells.ClearContents
[a2:i2] = Array(&序号&, &股票代码&, &股票简称&, &相关资料&, &业绩变动&, &业绩变动幅度&, &预告类型&, &上年同期净利润(万元)&, &公告日期&)
For i = 1 To 2 '导入1到37页
& & Call test2(i)
阅读权限20
在线时间 小时
为啥报错啊
Sub 新浪行情()
& & Cells.Clear
& & Dim arr()
& & With CreateObject(&Msxml2.XMLHTTP&)
& && &&&.Open &GET&, &.cn/data/#stock&, False
& && &&&.send
& && &&&str1 = Split(.responseText, &{&)
& & End With
& & ReDim arr(1 To UBound(str1), 1 To 19)
& & With CreateObject(&MSScriptControl.ScriptControl&)
& && &&&.Language = &JScript&
& && &&&For p = 1 To UBound(str1) - 1
& && && &AddCode &var a = {& & Replace(str1(p), &},&, &};&)
& && && && &arr(p, 1) = .Eval(&a.symbol&)
& && && && &arr(p, 2) = .Eval(&a.name&)
& && && && &arr(p, 3) = .Eval(&a._5low&)
& && && && &arr(p, 4) = .Eval(&a._5high&)
& && && && &arr(p, 5) = .Eval(&a._5changes&)
& && && && &arr(p, 6) = .Eval(&a._10low&)
& && && && &arr(p, 7) = .Eval(&a._10high&)
& && && && &arr(p, 8) = .Eval(&a._10changes&)
& && && && &arr(p, 9) = .Eval(&a._20low&)
& && && && &arr(p, 10) = .Eval(&a._20high&)
& && && && &arr(p, 11) = .Eval(&a._20changes&)
& && && && &arr(p, 12) = .Eval(&a._60low&)
& && && && &arr(p, 13) = .Eval(&a._60high&)
& && && && &arr(p, 14) = .Eval(&a._60changes&)
& && && && &arr(p, 15) = .Eval(&a.day&)
& && && && &arr(p, 16) = .Eval(&a.flag5&)
& && && && &arr(p, 17) = .Eval(&a.flag10&)
& && && && &arr(p, 18) = .Eval(&a.flag20&)
& && && && &arr(p, 19) = .Eval(&a.flag60&)
& && &&&Next p
& & End With
& & Range(&a2&).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
& & [a1:O1] = Split(&代码,名称,5日最低价,5日最高价,5日涨跌幅,01日最低价,01日最高价,10日涨跌幅,20日最低价,20日最高价,20日涨跌幅,60日最低价,60日最高价,60日涨跌幅,日期&, &,&)
阅读权限50
在线时间 小时
因为抓取程序一般来讲并不通用,所以要针对你所要的数据网页进行有针对的编程抓取。
阅读权限20
在线时间 小时
求助:有人能帮我写出来吗?谢谢
阅读权限50
在线时间 小时
本帖最后由 onlycxb 于
14:27 编辑
Sub 新浪行情()
& & Cells.Clear
& & Dim n As Integer, Js As Object
& & Dim i As Integer, j As Integer, m As Integer, a As Object, arrdata(1 To 10000, 1 To 24)
& & Set Js = CreateObject(&scriptcontrol&)
& & Js.Language = &jscript&
& & With CreateObject(&Msxml2.XMLHTTP&)
& && &&&.Open &GET&, &http://money..cn/d/api/openapi_proxy.php/?__s=[[%22hq%22,%22hs_a%22,%22%22,0,1,40]]&, False
& && &&&.send
& && &&&Js.addcode &var dy= & & .responsetext
& && &&&n = Application.WorksheetFunction.RoundUp((Js.eval(&dy[0].count&) / 80), 0)
& && &&&For i = 1 To n
& && && && &.Open &GET&, &http://money..cn/d/api/openapi_proxy.php/?__s=[[%22hq%22,%22hs_a%22,%22%22,0,&& i&&&&,80]]&, False'这里已经修改,引用了变量i
& && && && &.send
& && && && &Js.addcode &dy= & & .responsetext
& && && && &For Each a In Js.eval(&dy[0].items&)
& && && && && & m = m + 1
& && && && && & For j = 0 To 23
& && && && && && &&&arrdata(m, j + 1) = CallByName(a, j, VbGet)
& && && && && & Next j
& && && && &Next a
& && &&&Next i
& & End With
& & [a2].Resize(m, 24) = arrdata
End Sub复制代码
阅读权限20
在线时间 小时
谢谢onlycxb老师,帮我重写了程序,能加我qq吗?
阅读权限20
在线时间 小时
& & & & & & & &
谢谢onlycxb老师,帮我重写了程序,可是这个程序是每240行重复的,这个循环在哪儿能指点一下吗,能加识别重复的功能吗?
阅读权限50
在线时间 小时
五指山888 发表于
谢谢onlycxb老师,帮我重写了程序,可是这个程序是每240行重复的,这个循环在哪儿能指点一下吗,能加识别重 ...
5楼代码已经修正
阅读权限20
在线时间 小时
谢谢老师!
玩命加载中,请稍候
玩命加载中,请稍候
Powered by
本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任! & & 本站特聘法律顾问:徐怀玉律师 李志群律师

我要回帖

更多关于 网址谢谢 的文章

 

随机推荐