请前辈们编写一个网抓的宏

13907933959

duquancai 发表于 2016-7-25 00:59
建议你一本书抓一次，一本书保存为一个word文件。
比如：第一本书，参数这样：for i=1 to 1    for j=3  ...

前辈好！
回复正在审核中…。

kqbt

duquancai 发表于 2016-7-24 18:43
Sub shishi()
    Dim strText$, n%
    URL = "http://www.tcm100.com/"

正则很强大！

duquancai

13907933959 发表于 2016-7-25 07:29
前辈好！感谢前辈！可不可一次抓取5本或10本？如可该如何设置？还有就是如前面的5本如以抓取了，又如何让它 ...

下面代码是网抓整个网站的内容，请一定要注意看代码中的注释，还是那个话：建议一本抓一个word文档，你实在要5本一抓也行。
比如：For i = 1 To UBound(arr)    改为：For i = 1 To 1  抓第一本  For i = 2 To 2  抓第三本 For i = 3 To 3  抓第三本；For i = 1 To 5 抓第一本到第五本 For i = 1 To 10  抓第一本到第10本。

1. Sub shishi()
   
2.     Dim strText$, i&, j&, arr, arr1
   
3.     URL = "http://www.tcm100.com/"
   
4.     Application.ScreenUpdating = True
   
5.     With CreateObject("msxml2.xmlhttp")
   
6.         .Open "GET", URL & "zhongyiguji.aspx", False
   
7.         .send
   
8.         strText = .responseText
   
9.         arr = Split(strText, "<a target='_blank' href='") '表示有多少本书（本网站共有“762本书”)
   
10.         For i = 1 To UBound(arr) '建议每一次就设置“1”就是抓一本书，设置“2”就是抓第二本书，一定要改，否则把整个网站都抓下来了！呵呵呵！！！
    
11.             .Open "GET", URL & Split(Split(strText, "<a target='_blank' href='")(i), "'>")(0), False
    
12.             .send
    
13.             strText = .responseText
    
14.             arr1 = Split(strText, "<a target='_blank' href='")
    
15.             For j = 1 To UBound(arr1)  '这个循环表示每一本书中的数目数量
    
16.                 .Open "GET", Split(Split(strText, "<a target='_blank' href='")(j), "'>")(0), False
    
17.                 .send
    
18.                 strText = strText & .responseText '表示包含所有书的所有页面内容的超文本
    
19.             Next
    
20.         Next
    
21. '        Debug.Print strText
    
22.     End With
    
23.     With CreateObject("VBScript.Regexp")
    
24.         .Global = True
    
25.         .Pattern = "<td[\s\S]*?<div\s*class='title'[\s\S]*?>([\s\S]+?)<[\s\S]*?<div\s* class='content'>([\s\S]+?)</div>[\s\S]*?</td>"
    
26.         For Each RegMatch In .Execute(strText)
    
27.             t1 = RegMatch.SubMatches(0)
    
28.             t2 = RegMatch.SubMatches(1)
    
29.             t = t & t1 & Chr(13) & t2 & Chr(13)
    
30.         Next
    
31.         .Pattern = "(?:<a\s*href=[\s\S]+?>)|</a>": t = .Replace(t, "")
    
32.         .Pattern = "(?!<br>)(?:&nbsp;)+": t = .Replace(t, "  ")
    
33.         .Pattern = "<br>\s+": t = .Replace(t, Chr(13))
    
34.     End With
    
35.     Application.ScreenUpdating = True
    
36.     Documents.Add.Content.Text = t
    
37. End Sub

复制代码

duquancai

13907933959 发表于 2016-7-25 07:29
前辈好！感谢前辈！可不可一次抓取5本或10本？如可该如何设置？还有就是如前面的5本如以抓取了，又如何让它 ...

只有分步抓，我测试了，就是只抓第二本书，就会抓不下来。你还想咋地！
我重新编写了抓取整网抓的通用代码（在审核中，肯定是运行会出错），所以手动逐步抓吧？
改两个地方：第（1）：  For i = 1 To UBound(arr)，这个表示整个网抓的所有书共762本书（看arr数组的个数就知道了） 改为： For i = 1 To 1   抓第一本    For i = 2 To 2  抓第二本。第（2）需要改的： For j = 1 To UBound(arr1)，这个表示某一本书下面的所有目录或者所有章节，自己看数组arr1是个数就知道有多少了。
整个代码只抓2层，如果有第三层，不抓了！太累！呵呵呵！

13907933959

duquancai 发表于 2016-7-25 13:45
只有分步抓，我测试了，就是只抓第二本书，就会抓不下来。你还想咋地！
我重新编写了抓取整网抓的通用代 ...

前辈好！
为了我这样一个生手，太难为了您，真是让人感动！在下拜谢了！感谢前辈！！！