刚学网抓，试着抓了下EH论坛的帖子。

kldxlb

13907933959 发表于 2017-1-20 16:40
感谢前辈帮忙！

我也是刚学网抓，看源码看得我眼花缭乱的，有几条抓不到，马上下班的了，先提交上来，有时间再写吧

1. Function strResponse(ByVal url As String) As String
   
2. On Error GoTo UNDEFIND '若异常则返回“访问异常”
   
3. url = "http://" & Replace(url, "http://", "")
   
4. Dim strText As String
   
5. DoEvents
   
6. With CreateObject("MSXML2.XMLHTTP")
   
7.     .Open "GET", url, False
   
8.     .Send
   
9.     strResponse = ByteToStr(.responsebody, "gb2312")
   
10.     GoTo FUNRETURN '若正正常则返回数据
    
11.     'Debug.Print strResponse
    
12. End With
    
13. UNDEFIND: strResponse = "访问异常"
    
14. FUNRETURN:
    
15. End Function
    
16. Function strTA(ByVal str As String, strStart As String, strStop As String)
    
17.     strTA = Split(Split(str, strStart)(1), strStop)(0)
    
18. End Function
    
19. Function strTaformURL(ByVal url As String, strStart As String, Optional strStop As String = "</html>")
    
20.     strTaformURL = strTA(strResponse(url), strStart, strStop)
    
21. End Function
    
22. Public Sub URL_REPLY()
    
23.     Dim r As Long
    
24.     Dim sh As Worksheet
    
25.     Dim eachTitle 'Title数组
    
26.     Set sh = ActiveSheet
    
27.     pgcount = strTaformURL("http://club.excelhome.net/thread-1322442-1-1.html", "<span title=""共 ", " 页"">")
    
28.     'Debug.Print pgcount
    
29.     For pg = 1 To pgcount
    
30.         response = strResponse("http://club.excelhome.net/thread-1322442-1-1.html")
    
31.         eachFloor = Split(response, "</em>楼</a>")
    
32.         maxrow = sh.UsedRange.Rows.Count
    
33.         For i = 1 + maxrow To UBound(eachFloor) + maxrow '跳过下标为0的第一部分
    
34.             If InStr(eachFloor(i - maxrow), "<div class=""quote""><blockquote><font size=""2"">") = 0 Then '不是回复贴
    
35.                 strFloor = Split(Split(Split(Split(eachFloor(i - maxrow), "<div class=""t_fsz"">")(1), "<table cellspacing=""0"" cellpadding=""0""><tr><td")(1), "</td></tr></table>")(0), """>")(1)
    
36.                 sh.Range("A" & i).Value = strFloor
    
37.             Else '是回复贴
    
38.                 rawFloor = strTA(eachFloor(i - maxrow), "</font></a></font><br />", "</blockquote></div><br />")
    
39.                 replyFloor = strTA(eachFloor(i - maxrow), "</blockquote></div><br />", "</td></tr></table>")
    
40.                 sh.Range("A" & i).Value = replyFloor
    
41.                 sh.Range("B" & i).Value = rawFloor
    
42.             End If
    
43.         Next
    
44.     Next
    
45. End Sub
    
46. 
    
47. Function ByteToStr(arrByte, strCharset As String) As String
    
48.     With CreateObject("Adodb.Stream")
    
49.         .Type = 1 'adTypeBinary
    
50.         .Open
    
51.         .Write arrByte
    
52.         .Position = 0
    
53.         .Type = 2 'adTypeText
    
54.         .Charset = strCharset
    
55.         ByteToStr = .Readtext
    
56.         .Close
    
57.     End With
    
58. End Function

复制代码

13907933959

kldxlb 发表于 2017-1-20 18:09
我也是刚学网抓，看源码看得我眼花缭乱的，有几条抓不到，马上下班的了，先提交上来，有时间再写吧

前辈好！
辛苦了！
好象还是不能运行，和昨天一样提示：编译错误：用户定义类型未定义。
进代码窗口看，这句 Dim sh As Worksheet 代码的 sh As Worksheet 被蓝色盖住。
劳您再看看，谢谢！

kldxlb

13907933959 发表于 2017-1-21 07:53
前辈好！
辛苦了！
好象还是不能运行，和昨天一样提示：编译错误：用户定义类型未定义。

我想知道你用的是VB还是VBA，如果是VBA的话，是不是用的2003版的Office？如果是的话把Dim sh As Worksheet改成Dim sh As Variant试试

13907933959

kldxlb 发表于 2017-1-21 15:41
我想知道你用的是VB还是VBA，如果是VBA的话，是不是用的2003版的Office？如果是的话把Dim sh As Workshee ...

前辈好！
辛苦了！
我用的是VBA
是2003版的Office
把 Dim sh As Worksheet 改成 Dim sh As Variant
还是不能运行，提示：类型不匹配。
劳您再看看，谢谢！

百度不到去谷歌

换个网站实验吧吧 这样如果实验的人多了 对eh会造成疑似dos攻击  造成服务器带宽无谓的消耗

kldxlb

13907933959 发表于 2017-1-21 15:57
前辈好！
辛苦了！
我用的是VBA

我也不是太懂，应该是版本的问题吧。之前见好多用03版的碰到很多问题，要不你试试换个高版本的？

Kaohsing

试着也做了一个，前100页初次运行2分多，再次运行2秒多，由于初学正则，漏采几条。恳请帮助。

Kaohsing

百度不到去谷歌 发表于 2017-1-21 17:36
换个网站实验吧吧 这样如果实验的人多了 对eh会造成疑似dos攻击  造成服务器带宽无谓的消耗

光返回相同的数据。

13907933959

kldxlb 发表于 2017-1-21 18:18
我也不是太懂，应该是版本的问题吧。之前见好多用03版的碰到很多问题，要不你试试换个高版本的？

前辈好！
如换了高版本会很麻烦，因牵涉到很多VBA的代码，它们对应的是2003版本的，有可能会用不了或不好用。
不管怎样，谢谢前辈！