Question

Siddharth Rout在另一篇文章中贴出了我正在寻找的内容。唯一的问题是，当脚本循环遍历目录中的文件时，我需要增加替换变量。例如，我的文件名为001 - Wordfile.docm，002 - wordfile2.docm，依此类推。所以对于第一个文件，查找将是001X替换001X，然后循环到下一个文件并找到001X替换002x，下一个文件001X替换为003X，依此类推。这样做的原因是我们复制了001文件350次，但后来需要更改word doc中的excel链接以指向excel中的相应工作表。我希望我说清楚，而不是更复杂。无论如何，这是Sid发布的代码。如何在循环浏览文档时添加脚本以更改替换值。

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
' 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:\LQ\"
    '~~> This is the extention you want to go in for
    strFilePattern = "*.docm"

    '~~> 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 = "001X"
                .Replacement.Text = Left(strFileName,3) & "X"
                .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

Answer 1

With rngStory.Find
   .Text = "001X"
   .Replacement.Text = Left(strFileName,3) & "X"
   .Wrap = wdFindContinue
   .Execute Replace:=wdReplaceAll
End With

使用VBA递增替换变量查找和替换文件夹中所有.docm中的文本

1 个答案: