MS Word 使用 VBA 在文件夹中的所有文档中查找和替换文本
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/19179571/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
MS Word Find and Replace text within all docs in a folder using VBA
提问by Alex H
I have come across the code below that searches through an open word document and performs a find and replace within all areas (StoryRanges) of the document. It works fine, however i would like to ask how i could modify this code to look at all documents in a chosen folder and perform the find and replace for all docs within that folder?, rather than just the active document which is open?
我遇到了下面的代码，它搜索打开的 Word 文档并在文档的所有区域 (StoryRanges) 内执行查找和替换。它工作正常，但是我想问一下如何修改此代码以查看所选文件夹中的所有文档并对该文件夹中的所有文档执行查找和替换？，而不仅仅是打开的活动文档？
My plan is to assign the macro to a button in Excel so that the user can click that, navigate to the folder and action the find and replace across lots of documents at once.
我的计划是将宏分配给 Excel 中的一个按钮，以便用户可以单击该按钮，导航到该文件夹并同时在大量文档中执行查找和替换操作。
Am I able to amend the 'IN ActiveDocument.StoryRanges' section to look at a folder instead? I'm not sure what i can amend it to. btw... i am new to vba and trying to research & learn as i go... I very much appreciate your time, patience and any help you can give while i'm trying to find my feet with it - Alex.
我可以修改“IN ActiveDocument.StoryRanges”部分以查看文件夹吗？我不确定我可以修改它。顺便说一句...我是 vba 的新手，我正在尝试研究和学习...我非常感谢您的时间、耐心和您在我尝试找到自己的脚时可以提供的任何帮助 - 亚历克斯。
Dim myStoryRange As Range
将 myStoryRange 调暗为范围
For Each myStoryRange In ActiveDocument.StoryRanges
With myStoryRange.Find
.Text = "Text to find to replace goes here"
.Replacement.Text = "And the replacement text goes here"
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Do While Not (myStoryRange.NextStoryRange Is Nothing)
Set myStoryRange = myStoryRange.NextStoryRange
With myStoryRange.Find
.Text = "Text to find to replace goes here"
.Replacement.Text = "And the replacement text goes here"
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Loop
Next myStoryRange
回答by Siddharth Rout
I have commented the code so you shouldn't have any problem understanding it. Still if you do then lemme know...
我已经注释了代码，所以你理解它应该没有任何问题。如果你这样做了，那么让我知道......
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
' This code uses Late Binding to connect to word and hence you '
' you don't need to add any references to it '
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
Option Explicit
'~~> Defining Word Constants
Const wdFindContinue As Long = 1
Const wdReplaceAll As Long = 2
Sub Sample()
Dim oWordApp As Object, oWordDoc As Object, rngStory as Object
Dim sFolder As String, strFilePattern As String
Dim strFileName As String, sFileName As String
'~~> Change this to the folder which has the files
sFolder = "C:\Temp\"
'~~> This is the extention you want to go in for
strFilePattern = "*.docx"
'~~> Establish an Word application object
On Error Resume Next
Set oWordApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set oWordApp = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0
oWordApp.Visible = True
'~~> Loop through the folder to get the word files
strFileName = Dir$(sFolder & strFilePattern)
Do Until strFileName = ""
sFileName = sFolder & strFileName
'~~> Open the word doc
Set oWordDoc = oWordApp.Documents.Open(sFileName)
'~~> Do Find and Replace
For Each rngStory In oWordDoc.StoryRanges
With rngStory.Find
.Text = "Text to find to replace goes here"
.Replacement.Text = "And the replacement text goes here"
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next
'~~> Close the file after saving
oWordDoc.Close SaveChanges:=True
'~~> Find next file
strFileName = Dir$()
Loop
'~~> Quit and clean up
oWordApp.Quit
Set oWordDoc = Nothing
Set oWordApp = Nothing
End Sub
