Macro to update all fields in a word document

Question

I have built - over the years - a vba macro that is supposed to update all fields in a word document.

I invoke this macro before releasing the document for review to ensure all headers and footers etc are correct.

Currently - it look like this:

Sub UpdateAllFields()
'
' UpdateAllFields Macro
'
'
    Dim doc As Document ' Pointer to Active Document
    Dim wnd As Window ' Pointer to Document's Window
    Dim lngMain As Long ' Main Pane Type Holder
    Dim lngSplit As Long ' Split Type Holder
    Dim lngActPane As Long ' ActivePane Number
    Dim rngStory As Range ' Range Objwct for Looping through Stories
    Dim TOC As TableOfContents ' Table of Contents Object
    Dim TOA As TableOfAuthorities 'Table of Authorities Object
    Dim TOF As TableOfFigures 'Table of Figures Object
    Dim shp As Shape

    ' Set Objects
    Set doc = ActiveDocument
    Set wnd = doc.ActiveWindow

    ' get Active Pane Number
    lngActPane = wnd.ActivePane.Index

    ' Hold View Type of Main pane
    lngMain = wnd.Panes(1).View.Type

    ' Hold SplitSpecial
    lngSplit = wnd.View.SplitSpecial

    ' Get Rid of any split
    wnd.View.SplitSpecial = wdPaneNone

    ' Set View to Normal
    wnd.View.Type = wdNormalView

    ' Loop through each story in doc to update
    For Each rngStory In doc.StoryRanges
        If rngStory.StoryType = wdCommentsStory Then
            Application.DisplayAlerts = wdAlertsNone
            ' Update fields
            rngStory.Fields.Update
            Application.DisplayAlerts = wdAlertsAll
        Else
           ' Update fields
           rngStory.Fields.Update
            If rngStory.StoryType <> wdMainTextStory Then
                While Not (rngStory.NextStoryRange Is Nothing)
                    Set rngStory = rngStory.NextStoryRange
                    rngStory.Fields.Update
                Wend
            End If
        End If
    Next

    For Each shp In doc.Shapes
      If shp.Type <> msoPicture Then
        With shp.TextFrame
            If .HasText Then
                shp.TextFrame.TextRange.Fields.Update
            End If
        End With
      End If
    Next

    ' Loop through TOC and update
    For Each TOC In doc.TablesOfContents
        TOC.Update
    Next

    ' Loop through TOA and update
    For Each TOA In doc.TablesOfAuthorities
        TOA.Update
    Next

    ' Loop through TOF and update
    For Each TOF In doc.TablesOfFigures
        TOF.Update
    Next

    ' Header and footer too.
    UpdateHeader
    UpdateFooter

    ' Return Split to original state
    wnd.View.SplitSpecial = lngSplit

    ' Return main pane to original state
    wnd.Panes(1).View.Type = lngMain

    ' Active proper pane
    wnd.Panes(lngActPane).Activate

    ' Close and release all pointers
    Set wnd = Nothing
    Set doc = Nothing

End Sub

Sub UpdateFooter()
    Dim i As Integer

     'exit if no document is open
    If Documents.Count = 0 Then Exit Sub
    Application.ScreenUpdating = False

     'Get page count
    i = ActiveDocument.BuiltInDocumentProperties(14)

    If i >= 1 Then 'Update fields in Footer
        For Each footer In ActiveDocument.Sections(ActiveDocument.Sections.Count).Footers()
         footer.Range.Fields.Update
        Next
    End If

    Application.ScreenUpdating = True
End Sub

 'Update only the fields in your footer like:
Sub UpdateHeader()
    Dim i As Integer

     'exit if no document is open
    If Documents.Count = 0 Then Exit Sub
    Application.ScreenUpdating = False

     'Get page count
    i = ActiveDocument.BuiltInDocumentProperties(14)

    If i >= 1 Then 'Update fields in Header
        For Each header In ActiveDocument.Sections(ActiveDocument.Sections.Count).Headers()
         header.Range.Fields.Update
        Next
    End If

    Application.ScreenUpdating = True
End Sub

I have noticed recently that it sometimes misses some secions of the document. Today it missed First page footer -section 2- because the document version was not updated.

I have built this macro over a number of years and several bouts of research but I am not proud of it so please suggest a complete replacement if there is now a clean way of doing it. I am using Word 2007.

To test, create a word document and add a custom field named Version and give it a value. Then use that field {DOCPROPERTY Version \* MERGEFORMAT } in as many places as you can. Headers, Footers, first-page, subsequent page etc. etc. Remember to make a multi-section document with different header/footers. Then change the property and invoke the macro. It currently does quite a good job, handling TOCs and TOAs an TOFs etc, it just seems to skip footers (sometimes) in a multi-section document for example.

Edit

The challenging document that seems to cause the most problems is structured like this:

It has 3 sections.

Section 1 is for the title page and TOC so the first page of that section has no header/footer but does use the Version property on it. Subsequent pages have page numbering in roman numerals for the TOC.

Section 2 is for the body of the document and has headers and footers.

Section 3 is for the copyright blurb and this has a very strange header and a cut-down footer.

All footers contain the Version custom document property.

My code above seems to work in all cases except sometimes it misses first page footer of sections 2 and 3.

Answer 1

For years, the standard I've used for updating all fields (with the exception of TOC, etc. which are handled separately) in a document is the one the Word MVPs use and recommend, which I'll copy here. It comes from Greg Maxey's site: http://gregmaxey.mvps.org/word_tip_pages/word_fields.html. One thing it does that I don't see in your version is update any fields in Shapes (text boxes) in the header/footer.

Public Sub UpdateAllFields()
  Dim rngStory As Word.Range
  Dim lngJunk As Long
  Dim oShp As Shape
  lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
  For Each rngStory In ActiveDocument.StoryRanges
    'Iterate through all linked stories
    Do
      On Error Resume Next
      rngStory.Fields.Update
      Select Case rngStory.StoryType
        Case 6, 7, 8, 9, 10, 11
          If rngStory.ShapeRange.Count > 0 Then
            For Each oShp In rngStory.ShapeRange
              If oShp.TextFrame.HasText Then
                oShp.TextFrame.TextRange.Fields.Update
              End If
            Next
          End If
        Case Else
          'Do Nothing
        End Select
        On Error GoTo 0
        'Get next linked story (if any)
        Set rngStory = rngStory.NextStoryRange
      Loop Until rngStory Is Nothing
    Next
End Sub

Answer 2

Some research and experimentation produced the following addition which seems to solve the additional problem of updating the headers/footers in a multi-section document.

Add the following dimensions to the earlier answer:

dim sctn as Word.Section
dim hdft as Word.HeaderFooter

And then, add to the earlier code

for each sctn in doc.Sections
  for each hdft in sctn.Headers
     hdft.Range.Fields.Update
   next
   for each hdft in sctn.Footers
     hdft.Range.Fields.Update
   next
next

However - I am still not happy with this code and would very much like to replace it with something less hacky.