Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
Dim Rng As Range, Sctn As Section, HdFt As HeaderFooter, Shp As Shape
Const strFnd As String = "Find String": Const strRep As String = "Replace String"
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, _
    AddToRecentFiles:=False, Visible:=False)
  With wdDoc
     For Each Rng In .StoryRanges
       Call Update(Rng, strFnd, strRep)
     Next
    For Each Sctn In .Sections
      For Each HdFt In Sctn.Headers
        With HdFt
          If .LinkToPrevious = False Then
              'Process the header
            With .Range.Find
              Call Update(Rng, strFnd, strRep)
            End With
              'Process textboxes etc in the header
            For Each Shp In .Shapes
              With Shp.TextFrame
                If .HasText Then
                  With .TextRange.Find
                    Call Update(Rng, strFnd, strRep)
                  End With
                End If
              End With
            Next
          End If
        End With
      Next
    Next
    .Close SaveChanges:=True
  End With
  strFile = Dir()
Wend
Set wdDoc = Nothing
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

Sub Update(Rng As Range, strFnd As String, strRep As String)
With Rng.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = strFnd
  .Replacement.Text = strRep
  .Forward = True
  .Wrap = wdFindStop
  .Format = False
  .Execute Replace:=wdReplaceAll
End With
End Sub