Dim aStory As Range 
Dim aField As Field 
 
' Automatically update all fields in document when it is opened
For Each aStory In ActiveDocument.StoryRanges 
  For Each aField In aStory.Fields 
    aField.Update 
  Next aField 
Next aStory

 ' Sub for recursing through multiple files in directories, to perform a common task
Sub MassEdit_Loop() 
    Dim MyPath As String, FilesInPath As String, RegEx As String, Template As String, NewFile As String 
    Dim MyFiles() As String 
    Dim FNum As Long 
    Dim MainDoc As Word.Document, MainDoc2 As Word.Document 
    Dim wdApp As Word.Application 
    Dim wdApp2 As Word.Application 
     
    MyPath = "C:\Documents and Settings\beirol\Desktop\Existing" 
    Template = "C:\Documents and Settings\beirol\Desktop\Template\Procedure Template.doc" 
     ' This is the Regex for file searching (e.g. all .doc files in the folder)
    RegEx = "*.doc" 
     
     ' Call upon the Recursive File Name builder
    Dim colFiles As New Collection 
    RecursiveDir colFiles, MyPath, RegEx, True 
     ' Loop through the Filenames to collect them into an Array
    FNum = 0 
    Dim vFile As Variant 
    For Each vFile In colFiles 
        FNum = FNum + 1 
        ReDim Preserve MyFiles(1 To FNum) 
        MyFiles(FNum) = vFile 
    Next vFile 
     
    If FNum > 0 Then 
        For FNum = LBound(MyFiles) To UBound(MyFiles) 
            On Error Resume Next 
             
             ' Open template
            Set wdApp = CreateObject("word.Application") 
            wdApp.Visible = False 
            wdApp.ScreenUpdating = False 
            Set MainDoc = wdApp.Documents.Open(Template) 
             
             ' Open source document
            Set wdApp2 = CreateObject("word.Application") 
            wdApp2.Visible = False 
            wdApp2.ScreenUpdating = False 
            Set MainDoc2 = wdApp2.Documents.Open(MyFiles(FNum)) 
             
             ' Select all data from source doc
             ' Copy data
            wdApp2.Selection.WholeStory 
            wdApp2.Selection.Copy 
            wdApp.Selection.Paste 
             
             'Format the content to Guidelines
            wdApp.Selection.WholeStory 
            wdApp.Selection.Font.Name = "Verdana" 
            wdApp.Selection.Font.Size = 10 
            wdApp.Selection.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly 
            wdApp.Selection.ParagraphFormat.LineSpacing = 12 
             
             'set word back to normal
            wdApp2.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges 
            wdApp2.Application.Quit wdDoNotSaveChanges 
             
            wdApp2.Visible = True 
            wdApp2.ScreenUpdating = True 
            Set wdApp2 = Nothing 
             
             
            justFileName = Dir(MyFiles(FNum)) 
            NewFile = "C:\Documents and Settings\beirol\Desktop\Converted\" + justFileName 
            wdApp.ActiveDocument.SaveAs Filename:=NewFile 
            wdApp.ActiveDocument.Close 
            wdApp.Application.Quit wdDoNotSaveChanges 
             
            wdApp.Visible = True 
            wdApp.ScreenUpdating = True 
            Set wdApp = Nothing 
             
        Next FNum 
    End If 
    End Sub

 ' Sub for recursing through multiple files in directories, to perform a common task
Sub MassEdit_Loop() 
    Dim MyPath As String, FilesInPath As String, RegEx As String, Template As String, NewFile As String 
    Dim MyFiles() As String 
    Dim FNum As Long 
    Dim MainDoc As Word.Document, MainDoc2 As Word.Document 
    Dim wdApp As Word.Application 
    Dim RngStry As Word.Range, Fld As Word.Field 
    MyPath = "C:\Documents and Settings\beirol\Desktop\Existing" 
    Template = "C:\Documents and Settings\beirol\Desktop\Template\Procedure Template.doc" 
     ' This is the Regex for file searching (e.g. all .doc files in the folder)
    RegEx = "*.doc" 
 
     ' Call upon the Recursive File Name builder
    Dim colFiles As New Collection 
    RecursiveDir colFiles, MyPath, RegEx, True 
     ' Loop through the Filenames to collect them into an Array
    FNum = 0 
    Dim vFile As Variant 
    For Each vFile In colFiles 
        FNum = FNum + 1 
        ReDim Preserve MyFiles(1 To FNum) 
        MyFiles(FNum) = vFile 
    Next vFile 
 
    If FNum > 0 Then 
         ' Start Word
        Set wdApp = CreateObject("word.Application") 
        With wdApp 
            .Visible = False 
            .ScreenUpdating = False 
            For FNum = LBound(MyFiles) To UBound(MyFiles) 
                On Error Resume Next 
                justFileName = Dir(MyFiles(FNum)) 
                NewFile = "C:\Documents and Settings\beirol\Desktop\Converted\" + justFileName 
                Set MainDoc = .Documents.Open(FileName:=Template, AddToRecentFiles:=False) 
 
                 ' Open source document
                Set MainDoc2 = .Documents.Open(FileName:=MyFiles(FNum), AddToRecentFiles:=False) 
 
                 ' Select all data from source doc
                 ' Copy data
                MainDoc2.WholeStory.Copy 
                MainDoc2.Close SaveChanges:=wdDoNotSaveChanges 
                With MainDoc 
                    With .Range 
                        .Paste 
                         'Format the content to Guidelines
                        .Font.Name = "Verdana" 
                        .Font.Size = 10 
                        .ParagraphFormat.LineSpacingRule = wdLineSpaceExactly 
                        .ParagraphFormat.LineSpacing = 12 
                    End With 
                     ' update all fields in document
                    For Each RngStry In .StoryRanges 
                        For Each Fld In RngStry.Fields 
                            Fld.Update 
                        Next 
                    Next 
                    .SaveAs FileName:=NewFile, AddToRecentFiles:=False 
                    .Close 
                End With 
            Next FNum 
            .Quit 
        End With 
        Set wdApp = Nothing 
    End If 
End Sub