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

13907933959

http://www.tcm100.com/user/hxsjshl/
那位前辈有办法编写一个这样的宏，求赐教！谢谢！

duquancai

请你参考：
http://club.excelhome.net/thread-1159783-1-2.html

duquancai

请你测试：

Sub WordVBA网抓()
    Dim strText$, t$, t1$, t2$, t3$, RegMatch, i%
    Application.ScreenUpdating = False
    With CreateObject("msxml2.xmlhttp")
        For i = 2 To 395
            .Open "GET", "http://www.tcm100.com/user/hxsjshl/zzbook" & i & ".htm", False
            .send
            Do While .readyState <> 4
                DoEvents
            Loop
            strText = strText + .responseText
        Next
    End With
    With CreateObject("VBScript.Regexp")
        .Global = True
        .Pattern = "<td[\s\S]*?<div\s*class='title'[\s\S]*?>([\s\S]+?)</div>[\s\S]*?<div\s*class='title'>([\s\S]+?)</div>[\s\S]*?<div\s* class='content'>([\s\S]+?)</div>[\s\S]*?</td>"
        For Each RegMatch In .Execute(strText)
            t1 = RegMatch.SubMatches(0)
            t2 = RegMatch.SubMatches(1)
            t3 = RegMatch.SubMatches(2)
            t = t & t1 & Chr(13) & t2 & Chr(13) & t3 & Chr(13)
        Next
        .Pattern = "(?:<a\s*href=[\s\S]+?>)|</a>": t = .Replace(t, "")
        .Pattern = "(?!<br>)(?:&nbsp;)+": t = .Replace(t, "  ")
        .Pattern = "<br>\s+": t = .Replace(t, Chr(13))
    End With
    Application.ScreenUpdating = True
    Documents.Add.Content.Text = t
End Sub

13907933959

duquancai 发表于 2016-7-16 11:27
请你参考：
http://club.excelhome.net/thread-1159783-1-2.html

前辈好！
感谢指点，真是个好帖子，可是在下水平未到，一二下还学不来，能不能劳前辈写一个，在下将万分感谢！

duquancai

13907933959 发表于 2016-7-16 14:25
前辈好！
感谢指点，真是个好帖子，可是在下水平未到，一二下还学不来，能不能劳前辈写一个，在下将万分 ...

已经在你楼上，我写了一个。你测试一下看看是否满足你的需求？怎么修改一次就需要审核啊！！！！

13907933959

duquancai 发表于 2016-7-16 14:44
已经在你楼上，我写了一个。你测试一下看看是否满足你的需求？怎么修改一次就需要审核啊！！！！

前辈好！
抱歉、抱歉、刚才没注意，请您见谅！
刚测试了，用了不到一分钟就OK了，正是我想要的。真是“山外有山，天外有天”，让在下仰慕！
感谢前辈的出手相助！在下拜谢！下次再有问题恳请前辈再赐教！谢谢！

duquancai

13907933959 发表于 2016-7-16 15:02
前辈好！
抱歉、抱歉、刚才没注意，请您见谅！
刚测试了，用了不到一分钟就OK了，正是我想要的。真是“ ...

看你抓取的是“医学”方面的资料，你钻研医学是造福人类！因此我写个代码帮助节约时间以便你抽出更多的时间来钻研医学而帮助别人的病痛！

13907933959

duquancai 发表于 2016-7-16 15:24
看你抓取的是“医学”方面的资料，你钻研医学是造福人类！因此我写个代码帮助节约时间以便你抽出更多的时 ...

前辈好！
是的、我是个学中医的，读了几年的中医、前年刚毕业，去年刚跟一个师傅在度师，有前辈鼓励一定努力。前辈不但学艺精，还有一颗仁慈的心，如学医也一定是一个大医家！再次感谢前辈！

13907933959

duquancai 发表于 2016-7-16 13:01
请你测试：

Sub Main()

前辈好！
因前天的代码未收藏，今天再复制粘贴3楼的代码用不了，不面这行代码在代码窗口显示红色。
.Pattern = "(?:<a\s*href=[\s\S]+?>)|</a>|<br>": t = .Replace(t, "")        .Pattern = "(&nbsp;)+": t = .Replace(t, Chr(13))
劳请前辈再看看，谢谢！另外、再外行的问一下前辈，如再要抓取其它类似网站的文字，是不是更换一下网址即可？

duquancai

13907933959 发表于 2016-7-18 10:43
前辈好！
因前天的代码未收藏，今天再复制粘贴3楼的代码用不了，不面这行代码在代码窗口显示红色。
.Pa ...

那是因为我在VBE中粘贴到论坛时候，换换引起的语法问题。我重新再修改了！审核通过后你在试一试吧！