All main code - hope it makes some sense!

Private RawPath
Private LockedPath
Private MergedPath
Private ThisContainer
Private LookupPath
Option Base 1

Static Sub LockDocuments(Edition As String, Version As String)

'   8/5 add update to header/footer

   Dim Marks As Integer
   Dim i As Integer
   Dim CurName As String
   Dim aMarksArray() As String
   Dim Month As String
   Dim Year As String
   Dim MyTOC As TableOfContents
   Dim myIndex As Index

'   Turn off display, establish which document called routine and set up all
paths

   Year = "2007"
   Month = "May"
   
   CurName = Application.ActiveDocument.Name

   RawPath = "C:\Documents and Settings\All Users\Documents\Work\AS Book\"
+ Year + "\" + Month + "\Raw\"
   LockedPath = "C:\Documents and Settings\All Users\Documents\Work\AS
Book\" + Year + "\" + Month + "\Locked\"
   MergedPath = "C:\Documents and Settings\All Users\Documents\Work\AS
Book\" + Year + "\" + Month + "\Merged\"
   LookupPath = "C:\Documents and Settings\All Users\Documents\Work\AS
Book\Lookup\Document Data.xls"
       
   With Application
       .ScreenUpdating = False
       .Options.Pagination = False
   End With
   
'   Open relevant container document and freeze relevant bookmarks in main
body then in header/footers,
'   then unlock from data source.
   
   ThisContainer = RawPath + "Outline " + Edition + ".doc"
   
   Documents.Open (ThisContainer), addtorecentfiles:=False
   LockFields
   LockHeaders
   ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument
   
   ActiveWindow.View.Type = wdNormalView
   Application.Options.Pagination = False
       
'   Save modified Outline under new file name

'   ThisContainer = MergedPath + "The Red Guide - " + Edition + " - " +
Version + ".doc"
   ThisContainer = MergedPath + "The Red Guide - " + Edition + " Edition" +
" - " + CStr(Version) + ".doc"
   
   
   ActiveDocument.SaveAs (ThisContainer)
   
   Marks = ActiveDocument.Bookmarks.Count
   ReDim aMarksArray(Marks)
   For i = 1 To Marks
       aMarksArray(i) = ActiveDocument.Bookmarks(i).Name
   Next i
   
'   Loop through bookmarks backwards (so as not to end up doing alternate
ones when deletion takes place)
   
   For i = Marks To 1 Step -1
       If Left(aMarksArray(i), 2) = "bk" Then
           CurName = Right(aMarksArray(i), Len(aMarksArray(i)) - 2)
           Documents.Open (RawPath + CurName), addtorecentfiles:=False
           ViewType = wdNormalView
           Application.Options.Pagination = False

'   Lock all mergefields and separate from datasource
       LockFields
       ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument

'   Incorporate into container
           ActiveDocument.Range.WholeStory
           ActiveDocument.Select
           Selection.Copy
           ActiveDocument.MailMerge.DataSource.Close
           Application.ActiveWindow.Close savechanges:=wdDoNotSaveChanges
           Documents(ThisContainer).Select
           Selection.Collapse (Start)
           ActiveDocument.Bookmarks("bk" + CurName).Select
           Selection.Paste
           End If
   Next
   
'   Move completed container document to "Merged" folder and update fields.
     
   Selection.HomeKey Unit:=wdStory
 
   ViewType = wdPrintView
   Application.ActiveWindow.View = wdPrintView
   Application.Options.Pagination = True
   
   ActiveDocument.Save
   Application.ScreenUpdating = True
   ActiveDocument.Close
   
End Sub

Sub LockFields(Optional result As Boolean) 'Dummy

'   Sub routine to lock ALL fields in main body of text OTHER THAN
hyperlinks as values rather than code.

   For Each Field In ActiveDocument.Fields
       If Field.Type = wdFieldMergeField Or Field.Type = wdFieldRef Or
Field.Type = wdFieldSequence Or Field.Type = wdFieldPage Then
           Field.Unlink
       End If
   Next Field

End Sub

Sub LockHeaders(Optional result As Boolean) 'Dummy

'   Subroutine to lock ALL the fields in the headers and footers EXCEPT page
numbers as values rather than code.

Dim fField As Field
Dim sSection As Section
Dim hHeader As HeaderFooter
Dim hFooter As HeaderFooter

   For Each sSection In ActiveDocument.Sections
       For Each hHeader In sSection.Headers
           If hHeader.Exists Then
               For Each fField In hHeader.Range.Fields
                   fField.Unlink
               Next fField
           End If
       Next hHeader
       For Each fFooter In sSection.Footers
           If fFooter.Exists Then
               For Each fField In fFooter.Range.Fields
                   If fField.Type <> wdFieldPage Then
                       fField.Unlink
                   End If
               Next fField
           End If
       Next fFooter
       Next sSection

End Sub