如何将word里的每一篇文章提取出来，存入txt文件

feng1725

一个word文件里面有很多文章，我要把里面的每篇文章单独拷贝出来，放到txt文件里，文章的标题作为txt文件的文件名。


ps  我如何给解答的人、对我有帮助的人一定奖励？论坛里面有没有这种机制？

山菊花

量身定做，供参考。
按Alt+F8，选择“分割”程序运行它。

feng1725

山菊花 发表于 2015-11-25 08:47
量身定做，供参考。
按Alt+F8，选择“分割”程序运行它。

谢谢版主，能加一下你QQ吗？或者你方便加一下我QQ13467585，得对你表示以下感谢啊。

山菊花

feng1725 发表于 2015-11-25 09:31
谢谢版主，能加一下你QQ吗？或者你方便加一下我QQ13467585，得对你表示以下感谢啊。

处理word文档我也不怎么熟悉，如果能用就好。
说声谢谢已经足够了。也谢谢你。

feng1725

山菊花 发表于 2015-11-25 08:47
量身定做，供参考。
按Alt+F8，选择“分割”程序运行它。

问题一：

Arr = VBA.Split(Replace(myRange.Text, Chr(10), "") & Chr(13) & "人民日报评论员：", Chr(13))

对word文档（myRange.Text）进行替换，把换行chr(10)都替换成""，因为文本文档会自动换行。

在文档的最后加入chr（13）回车，还有“人民日报评论员:”字样

最后，根据回车chr(13)对word文档进行分割；是不是这样?  可是word文档中很多回车，并不是一篇文章一个回车


问题二：

For i = 129 To UBound(Arr)

129怎么来的？


问题三：

Open cPath & Format(n, "000 ") & Replace(Arr(i), "?", "") & ".txt" For Output As #1

Open cPath & Format(n, "000 ") & "人民日报评论员文章 " & ".txt" For Output As #1


一共两句代码，直接用下面一句就可以了，为什么还要上面一句

山菊花

问题一不是问题，用chr(13)分割，得到Arr()，每一元素Arr(i)就是一个段落，程序使用For/Nixt循环依次把所有段落输出到Txt文件中。
问题二，本文档从第129段开始是正文，前面的是目录。
问题三，前一句以序号及文章标题命名文件，后一句仅使用序号和“人民日报评论员文章”字样作文件名。当文章标题中包含非法字符不能用作文件名时，改用第二个方案命名。如果都用第二个方案命名，程序可改为：

1. Sub 分割()
   
2.     Dim myRange As Range, cPath$, cTxt$, n%, Arr
   
3.     cPath = ThisDocument.Path & "\Txt"
   
4.     If Dir(cPath, 16) = "" Then MkDir cPath
   
5.     Set myRange = ThisDocument.Range
   
6.     myRange.SetRange myRange.Start, myRange.End - 1
   
7.     Arr = VBA.Split(Replace(myRange.Text, Chr(10), "") & Chr(13) & "人民日报评论员：", Chr(13))
   
8.     For i = 129 To UBound(Arr)
   
9.         If Arr(i) Like "人民日报评论员：*" Then
   
10.             If i > 129 Then Close #1
    
11.             If i < UBound(Arr) Then
    
12.                 n = n + 1
    
13.                 Open cPath & Format(n, "000 ") & "人民日报评论员文章 " & ".txt" For Output As #1
    
14.                 Print #1, Arr(i)
    
15.             End If
    
16.         Else
    
17.             Print #1, Arr(i)
    
18.         End If
    
19.     Next
    
20.     MsgBox "保存完毕。"
    
21. End Sub

复制代码

kqbt

处理的速度简直是“秒杀”呀！收藏学习！
PS：谢谢楼主分享这篇文档！

山菊花

程序以“人民日报评论员：”开头作为是否标题的依据，仔细看看，有多篇文章不适用。
将程序改为是否粗体为依据（请重新下载附件），遗憾的是逐段读取内容拖慢了速度。
期待高手指教。

13907933959

山菊花 发表于 2015-11-25 08:47
量身定做，供参考。
按Alt+F8，选择“分割”程序运行它。

前辈好！
我下载附件运行该宏后，被禁止，（我用的还是2003版本，是个外行）我把该代码再粘贴进 NewMacros 窗口，删除 ThisDocument 处的代码后运行该宏，提示 “保存完毕” 可找不到提取的文件。求前辈赐教！谢谢！

山菊花

13907933959 发表于 2015-11-27 08:15
前辈好！
我下载附件运行该宏后，被禁止，（我用的还是2003版本，是个外行）我把该代码再粘贴进 NewMacr ...

保存在文件夹“Txt”中。