Microsoft Office Forums - View Single Post - Programatically change macros for existing templates

macropod · 07-14-2014, 09:51 PM

The following macro updates a line of VBA code in all code modules in all templates in the selected folder. The actual editing is done by the ‘EditCode’ module. The rest of the code is for the locating and looping through the files. The StrFnd and StrRep variables can contain from as little as a single letter to a whole code module.

Simply add the code to a document, then run it & point its browser to the folder containing the templates to be updated.

Code:

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

Note: You will need to allow access to the VBA project object model to use the code (File|Options|Trust Centre|Trust Centre Settings|Macro Settings)