Oct 24, 2014

Find and Replace in Multiple word Docs

Sub FindReplaceMultipleDocs()
 Dim oDoc As Document
 Dim fileNameArr(0 To 2) As String

 fileNameArr(0) = "C:\Document\A1.doc"
 fileNameArr(1) = "C:\Document\A2.doc"

 For fileNam = LBound(fileNameArr) To UBound(fileNameArr)
   
   WordBasic.DisableAutoMacros 1
   Set oDoc = Documents.Open(fileNameArr(fileNam))

   'Iterate through all story types in the current document
   For Each rngStory In ActiveDocument.StoryRanges
    'Iterate through all linked stories
    Do
     With rngStory.Find
      .Text = "<agencyAddress>"
      .Replacement.Text = "<csaAddressLine1>"
      .Wrap = wdFindContinue
      .Execute Replace:=wdReplaceAll
     End With
     With rngStory.Find
       .Text = "<agencyAddressLine1>"
       .Replacement.Text = "<csaAddressLine1>"
       .Wrap = wdFindContinue
       .Execute Replace:=wdReplaceAll
     End With
     'Get next linked story (if any)
     Set rngStory = rngStory.NextStoryRange
    Loop Until rngStory Is Nothing
     Next
  
   oDoc.SaveAs FileName:=fileNameArr(fileNam)
   oDoc.Close SaveChanges:=wdDoNotSaveChanges

   WordBasic.DisableAutoMacros 0
 Next fileNam
End Sub

No comments:

Search