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

时间:2013-10-04 10:59:53

标签: vba excel-vba ms-word word-vba excel

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

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

我可以修改'IN ActiveDocument.StoryRanges'部分来查看文件夹吗?我不确定我能修改它。顺便说一下......我是vba的新手并且正在努力研究和研究随时随地学习......我非常感谢你的时间,耐心和任何帮助,当我试图找到我的脚时 - 亚历克斯。

将myStoryRange Dim作为范围

    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

1 个答案:

答案 0 :(得分:4)

我已经对代码进行了评论,因此您不应该对它有任何问题。如果你这样做,那么知道......

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