使用VBA增量替換變量查找並替換文件夾中的所有.docm文本

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