Microsoft Office Forums - View Single Post

macropod · 03-27-2021, 02:40 PM

Try the following.

All you need do is ensure the first paragraph in the document you're running the code from (which shouldn't be one of the documents that need updating) contains the replacement string (i.e. from 'IF "TFT<[AuroraDatabase' to '\* MERGEFORMAT'). The only reason for that stipulation is that your replacement string employs mixed fonts (e.g. TNR & Wingdings).

Code:

Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
ActiveWindow.View.ShowFieldCodes = True
With ActiveDocument
  strDocNm = .FullName
  .Range(0, .Paragraphs(1).Range.End - 1).Copy
End With
strFile = Dir(strFolder & "\*.doc", vbNormal)
Do While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      With .Range.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "IF ""TFT[!^019^021]@\<CourtDistrict:EQ[0-9]\>*MERGEFORMAT"
        .Replacement.Text = "^c"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
      End With
      .Close SaveChanges:=True
    End With
  End If
  strFile = Dir()
Loop
Set wdDoc = Nothing
ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function