Sub UpdateTemplates()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.dotm", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  Call EditCode(wdDoc)
  wdDoc.Close SaveChanges:=True
  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 EditCode(wdDoc As Document)
Dim VBC, VBComp
Dim i As Long, j As Long, bFnd As Boolean
Dim StrFnd As String, StrRep As String, StrNew As String
StrFnd = "Old code line1" & vbCr & "Old code line2" 'Text to Find
StrRep = "New code line1" & vbCr & "New code line2" ' Replacement Text
Set VBC = wdDoc.VBProject.VBComponents
bFnd = True
For Each VBComp In VBC
  With VBComp.CodeModule
    i = 1
    j = .CountOfLines
    bFnd = .Find(Target:=StrFnd, StartLine:=i, StartColumn:=1, EndLine:=j, _
      EndColumn:=255, WholeWord:=True, MatchCase:=False, PatternSearch:=False)
    Do Until bFnd = False
      StrNew = Replace(.Lines(i, 1), StrFnd, StrRep)
      .ReplaceLine i, StrNew
      j = .CountOfLines
      bFnd = .Find(Target:=StrFnd, StartLine:=i, StartColumn:=1, EndLine:=j, _
        EndColumn:=255, WholeWord:=True, MatchCase:=False, PatternSearch:=False)
    Loop
  End With
Next VBComp
Set VBC = Nothing
End Sub