如何把文库内容一页一页的复制到word中

leedun

举个例子：https://wapwenku.baidu.com/view/73af3a3a3968011ca30091a2?pn=1&pu=
pn=1是第一页，页码共有14页。
我想把文库绿色底纹的内容按顺序一页一页的复制到word中，哪位前辈能帮忙写个宏？
万分感谢！！

jiminyanyan

才１４页，手工复制一下也才二三分钟。

leedun

jiminyanyan 发表于 2017-3-5 08:57
才１４页，手工复制一下也才二三分钟。

前辈好，我在这里就是举个例子，以后还有很多需要文库文档，有的文档能有三四百页，所以来求助各位前辈，望能指教！

duquancai

简单粗暴的写了一个》》》》》》》》》》》》》》》》》》》》》》》

1. Sub shishi()
   
2.     Dim strText$, thm As Object, reg As Object, mt, mh, S$, K$
   
3.     Set thm = CreateObject("msxml2.xmlhttp")
   
4.     For i = 1 To 14
   
5.         thm.Open "GET", "https://wapwenku.baidu.com/view/73af3a3a3968011ca30091a2?pn=" & i & "&pu=%20%20pn=1", False
   
6.         thm.send
   
7.         strText = strText & thm.responseText
   
8.     Next
   
9.     With CreateObject("VBScript.Regexp")
   
10.         .Global = True
    
11.         .Pattern = "<div class=""content bgcolor1"">([\s\S]+?)</div>"
    
12.         For Each mt In .Execute(strText)
    
13.             S = S & mt.submatches(0)
    
14.         Next
    
15.         .Pattern = "<p class=""txt"">([\s\S]+?)</p>"
    
16.         For Each mh In .Execute(S)
    
17.             K = K & mh.submatches(0) & vbCr
    
18.         Next
    
19.     End With
    
20.     ActiveDocument.Content.Text = K
    
21. End Sub

复制代码

duquancai

》》》》》》》》》》》》》》》》》》》》

leedun

duquancai 发表于 2017-3-5 12:55
简单粗暴的写了一个》》》》》》》》》》》》》》》》》》》》》》》

就喜欢这样的粗暴，感谢杜老师再次出手相助，解决了我一个大麻烦！

13907933959

duquancai 发表于 2017-3-5 12:55
简单粗暴的写了一个》》》》》》》》》》》》》》》》》》》》》》》

杜前辈好！
该代码适不适用复制“百度文库”上其它类似网页的内容？
如这个网址：https://wapwenku.baidu.com/view/e9da57d0d15abe23482f4d67?pu=%20%20pn=1
要怎样修改才可？劳前辈赐教，谢谢！

loquat

杜越来越厉害了

duquancai

13907933959 发表于 2017-3-6 16:42
杜前辈好！
该代码适不适用复制“百度文库”上其它类似网页的内容？
如这个网址：https://wapwenku.bai ...

几乎就是一样的，还是简单粗暴的写一下吧：

Sub shishi()
    Dim strText$, thm As Object, reg As Object, mt, mh, S$, K$
    Set thm = CreateObject("msxml2.xmlhttp")
    For i = 1 To 21
        thm.Open "GET", "https://wapwenku.baidu.com/view/e9da57d0d15abe23482f4d67?pn=" & i & "&pu=++pn%3D5", False
        thm.send
        strText = strText & thm.responseText
    Next
    With CreateObject("VBScript.Regexp")
        .Global = True
        .Pattern = "<div class=""content bgcolor1"">([\s\S]+?)</div>"
        For Each mt In .Execute(strText)
            S = S & mt.submatches(0)
        Next
        .Pattern = "<p class=""txt"">([\s\S]+?)</p>"
        For Each mh In .Execute(S)
            K = K & mh.submatches(0) & vbCr
        Next
    End With
    ActiveDocument.Content.Text = K
End Sub

13907933959

duquancai 发表于 2017-3-8 11:06
几乎就是一样的，还是简单粗暴的写一下吧：

Sub shishi()

杜前辈好！
代码测试OK！感谢前辈！
代码可通用，前辈知道我是个莱鸟，不知网址的这个后面的一段 " & i & "&pu=++pn%3D5" 根据不同的网址，不同页数的文章（只大概知道这个 For I = 1 To 14 是1至14页的意思），要具体怎样变化，能否再恳请前辈赐教？谢谢！