[已解决]网页抓取数据不稳定的原因在哪？求修改

瀚海人

一个从网页抓取数据的excel---VBA，每点击一次按钮，就会从网页固定位置抓取数据。
可是后来发现，即便是网页数据没有更新，点击按钮也会刷新数据，而且点击一次则刷新一次，每次的数据都不一样
而且更悲催的是：

刷新来的数据，竟然在网页上找不到，不知道这些数据是从哪儿来的

求大神给修改一下，稳定抓取指定网页的数据才好

最佳答案

月排行榜 / 总排行榜

xdragon

2014-12-3 21:45

1. Sub Quick_refresh()
   
2. Dim cookies, arr As Variant, XML As Object, tmp%(9)
   
3. Set XML = CreateObject("WinHttp.WinHttpRequest.5.1") '("Msxml2.XMLHTTP.5.0")
   
4. With XML
   
5. '获取COOKIE - START
   
6.       .Open "GET", "http://data.shishicai.cn/cqssc/haoma/", False
   
7.       .Send
   
8.       cookies = Split(.getallResponseHeaders(), "Set-Cookie: ")
   
9.       For i = LBound(cookies) + 1 To UBound(cookies)
   
10.             ckvalue = IIf(ckvalue = "", Split(cookies(i), ";")(0), ckvalue + "; " + Split(cookies(i), ";")(0))
    
11.       Next
    
12. '获取COOKIE - END
    
13.      .Open "POST", "http://data.shishicai.cn/handler/kuaikai/data.ashx", False
    
14.      .setRequestHeader "Referer", "http://data.shishicai.cn/cqssc/haoma/"
    
15.      .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
16.      .setRequestHeader "Cookie", ckvalue
    
17.      .Send "lottery=4&date=0001-01-01"
    
18.       lotsdata = Replace(Split(Split(.responsetext, "[")(1), "]")(0), """", "")
    
19.       arr = Split(lotsdata, ",")
    
20.       Columns("A:C").ClearContents
    
21.       Range(Cells(1, 1), Cells(1, 2)).Value = Array("期号", "开奖号码")
    
22.       Range("g1") = "开奖时间"
    
23.       ReDim brr(UBound(arr) - 10, 6)
    
24.       For i = UBound(arr) - 9 To UBound(arr)
    
25.           tmp(Split(arr(i), "_")(0)) = i - 120
    
26.       Next
    
27.       For i = LBound(arr) To UBound(arr) - 10
    
28.         brr(UBound(arr) - 10 - i, 0) = Split(arr(i), ";")(0)
    
29.         brr(UBound(arr) - 10 - i, 6) = Split(arr(i), ";")(2)
    
30.         For j = 1 To 5
    
31.             brr(UBound(arr) - 10 - i, j) = tmp(Mid(Split(arr(i), ";")(1), j, 1))
    
32.         Next
    
33.            'Range(Cells(i + 2, 1), Cells(i + 2, 3)).Value = Split(arr(i), ";")
    
34.       Next
    
35. End With
    
36. Range("a2").Resize(UBound(brr) + 1, 7) = brr
    
37. Set XML = Nothing
    
38. MsgBox "OK"
    
39. End Sub

复制代码

跳转到最佳答案楼层

瀚海人

终于有老师下载了，先致谢各位老师

xdragon

1. Sub Quick_refresh()
   
2. Dim cookies, arr As Variant, XML As Object, tmp%(9)
   
3. Set XML = CreateObject("WinHttp.WinHttpRequest.5.1") '("Msxml2.XMLHTTP.5.0")
   
4. With XML
   
5. '获取COOKIE - START
   
6.       .Open "GET", "http://data.shishicai.cn/cqssc/haoma/", False
   
7.       .Send
   
8.       cookies = Split(.getallResponseHeaders(), "Set-Cookie: ")
   
9.       For i = LBound(cookies) + 1 To UBound(cookies)
   
10.             ckvalue = IIf(ckvalue = "", Split(cookies(i), ";")(0), ckvalue + "; " + Split(cookies(i), ";")(0))
    
11.       Next
    
12. '获取COOKIE - END
    
13.      .Open "POST", "http://data.shishicai.cn/handler/kuaikai/data.ashx", False
    
14.      .setRequestHeader "Referer", "http://data.shishicai.cn/cqssc/haoma/"
    
15.      .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
16.      .setRequestHeader "Cookie", ckvalue
    
17.      .Send "lottery=4&date=0001-01-01"
    
18.       lotsdata = Replace(Split(Split(.responsetext, "[")(1), "]")(0), """", "")
    
19.       arr = Split(lotsdata, ",")
    
20.       Columns("A:C").ClearContents
    
21.       Range(Cells(1, 1), Cells(1, 2)).Value = Array("期号", "开奖号码")
    
22.       Range("g1") = "开奖时间"
    
23.       ReDim brr(UBound(arr) - 10, 6)
    
24.       For i = UBound(arr) - 9 To UBound(arr)
    
25.           tmp(Split(arr(i), "_")(0)) = i - 120
    
26.       Next
    
27.       For i = LBound(arr) To UBound(arr) - 10
    
28.         brr(UBound(arr) - 10 - i, 0) = Split(arr(i), ";")(0)
    
29.         brr(UBound(arr) - 10 - i, 6) = Split(arr(i), ";")(2)
    
30.         For j = 1 To 5
    
31.             brr(UBound(arr) - 10 - i, j) = tmp(Mid(Split(arr(i), ";")(1), j, 1))
    
32.         Next
    
33.            'Range(Cells(i + 2, 1), Cells(i + 2, 3)).Value = Split(arr(i), ";")
    
34.       Next
    
35. End With
    
36. Range("a2").Resize(UBound(brr) + 1, 7) = brr
    
37. Set XML = Nothing
    
38. MsgBox "OK"
    
39. End Sub

复制代码

瀚海人

多谢老师，马上测试

瀚海人

测试成功，速度很快，关键是数据终于稳定了下来{:2812:}

瀚海人

再次表示感谢