[轉貼] VBA-擷取包含關鍵字的所有段落丟到新文件中 關鍵字, VBA

偉婕

原發表者：leonchou (2005-04-30)

[問題] 自動擷取、另存有關某個指定關鍵字的所有段落, VBA怎麼寫?
這個問題令我想到了Unix/Linux的 grep 指令~
在Linux可以用短短一行指令解決的事,在Windows竟然要動用到程式~ 真是的... ^^|||
(如果真有這樣的內建指令或功能, 煩請指導, Thanks!!)

1. Sub 東找西找( )
   
2. 　Set myRange = ActiveDocument.Content
   
3. 　找啥 = InputBox("找啥?")
   
4. 　找到 = myRange.Find.Execute(找啥)
   
5. 　Do While 找到
   
6. 　　打包 = 打包 & myRange.Paragraphs(1)
   
7. 　　找到 = myRange.Find.Execute(找啥)
   
8. 　Loop
   
9. 　If IsEmpty(打包) Then MsgBox "找無!": Exit Sub
   
10. 　Documents.Add: Selection = 打包
    
11. End Sub

複製代碼

這個巨集是用 [尋找] 的方式，收集所有包含關鍵字的段落，然後一次丟到新文件中。
由於 Word2002 有 [多重選取] 的功能, 或許可以一次處理, 不須用到迴圈也說不定~~
PS. grep指令應該是只能處理純文字檔案, 想想又覺得拿這個來跟 Word / VBA 比較, 似乎有欠公平.. :p

--------------------------------------
有試過上面巨集的人可能會發現, 若是同一段的keyword有一個以上, 會被重複處理;也就是同一段可能會被重複擷取至新文件.
要避免這種情形, 可在 Do...Loop 間插入一行:
myRange.EndOf wdParagraph

1. Sub 東找西找( )
   
2. 　Set myRange = ActiveDocument.Content
   
3. 　找啥 = InputBox("找啥?")
   
4. 　找到 = myRange.Find.Execute(找啥)
   
5. 　Do While 找到
   
6. 　　打包 = 打包 & myRange.Paragraphs(1)
   
7. 　　myRange.EndOf wdParagraph
   
8. 　　找到 = myRange.Find.Execute(找啥)
   
9. 　Loop
   
10. 　If IsEmpty(打包) Then MsgBox "找無!": Exit Sub
    
11. 　Documents.Add: Selection = 打包
    
12. End Sub

複製代碼

myRange.EndOf wdParagraph 的意思是把 myRange 改設定至該段落的結尾,也就是直接從下一段繼續尋找,即可避免重複處理同一段的keyword.
wdParagraph 是 EndOF 指令(方法)的參數,指以 段落 為單位. 此參數可指定其他單位, 如 wdCharacter (字元)、wdWord (單字)...等等, 詳細用法請見 Word VBA 輔助說明~