MS Word 使用 VBA 在文件夹中的所有文档中查找和替换文本

Question

我遇到了下面的代码，它搜索打开的 Word 文档并在文档的所有区域 (StoryRanges) 内执行查找和替换。它工作正常，但是我想问一下如何修改此代码以查看所选文件夹中的所有文档并对该文件夹中的所有文档执行查找和替换？，而不仅仅是打开的活动文档？

我的计划是将宏分配给 Excel 中的一个按钮，以便用户可以单击该按钮，导航到该文件夹​​并立即在大量文档中执行查找和替换操作。

我可以修改“IN ActiveDocument.StoryRanges”部分以查看文件夹吗？我不确定我可以修改它。顺便说一句...我是 vba 的新手，我正在尝试研究和学习...我非常感谢您的时间、耐心以及您在我尝试找到自己的脚时可以提供的任何帮助 - 亚历克斯。

将 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

Answer 1

我已经注释了代码，所以你理解它应该没有任何问题。如果你这样做了，那么让我知道......

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
' 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