把网址里的每页（蓝色字链接的）依次点开复制里面的正文到Word文档上

duquancai

1. Sub WordVBA网抓()
   
2.     Dim strText$, i%, Otxt$, t1$, t2$, t3$
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = wdAlertsNone
   
5.     With CreateObject("msxml2.xmlhttp")
   
6.         For i = 2 To 395
   
7.             .Open "GET", "http://www.tcm100.com/user/hxsjshl/zzbook" & i & ".htm", False
   
8.             .send
   
9.             strText = .responseText
   
10.             With CreateObject("htmlfile")
    
11.                 .write strText
    
12.                 Set node = .getElementById("Panel_Article")
    
13.                 t1 = node.all.tags("div")(0).innerText
    
14.                 t2 = node.all.tags("div")(1).innerText
    
15.                 t3 = node.all.tags("div")(6).innerText
    
16.                 Otxt = Otxt & t1 & Chr(13) & t2 & Chr(13) & t3
    
17.             End With
    
18.         Next
    
19.     End With
    
20.     Application.DisplayAlerts = wdAlertsAll
    
21.     Application.ScreenUpdating = True
    
22.     Documents.Add.Content.Text = Otxt
    
23. End Sub

复制代码

13907933959

duquancai 发表于 2016-8-4 16:40
再试一试这个：

前辈好！

41楼这个宏能快如闪电的抓取“胡希恕讲伤寒论”全文。

13907933959

duquancai 发表于 2016-8-4 16:40
再试一试这个：

前辈好！

能得到多位前辈的多次相助，真是幸事！

前辈！40楼 这个宏运行时间较长，但能成功抓取“胡希恕讲伤寒论”全文，就是中途不知什么原因出现几次如附件中图片的提示？

13907933959

YZC51 发表于 2016-8-4 14:34
不客气！正如您所言：
如用自已的一技之长，帮别人度过一时的难关，是一个善举，也是一件乐事！
但愿人长 ...

前辈好！
来论坛有一年多，有幸能碰到几位好前辈，得到了很多很多的帮助，但更重要的是从您们身上学到了该怎样做人！

13907933959

duquancai 发表于 2016-8-4 17:42

前辈好！
42楼 这个宏能成功抓取“胡希恕讲伤寒论”全文，现在中途不会出现如附件中图片的提示？运行时间较41楼的代码要长一些。感谢前辈的多次出手相助！谢谢！