Resting Anchor

The Anchorage

Personal website of Gregory K. Maxey, Commander USN (Retired)

Word Field Macros
(A Microsoft Word Help & Tip page by Gregory K. Maxey)

DISCLAIMER/TERMS OF USE

The information, illustrations and code contained in my "Microsoft Word Tips" are provided free and without risk or obligation.

Click to acces PayPal Verification Service Click to acces PayPal Verification Service

However, the work is mine. If you use it for commercial purposes or benefit from my efforts through income earned or time saved then a donation, however small, will help to ensure the continued availability of this resource.

If you would like to donate, please use the appropriate donate button to access PayPal. Thank you!


The purpose of this Microsoft Word Tips & Microsoft Word Help page is to publish a collection of  VBA procedures (macros) useful for working with the Word field collection.

I love Word fields. They are a semi-advanced Word feature and with the exception of VBA, I think that they are the most powerful and useful feature in the application.  For more on Word fields in general, see my:  Word Fields

Technical Review

Before getting to the specific field macros, I think it is important to review a few technical issues (or perhaps quirks) associated with using VBA procedures in general and using them with the field collection in particular.

Many of you are familiar with Word's Find or Find and Replace feature. It has probably saved millions of people countless hours in document preparation and editing. Seemingly by magic it can find anything and replace it with anything else.

If you record a macro of running a Find and Replace operation and then run that macro, the magic of Find and Replace seems to have lost some of the shine.

Site Note IconNote: A full discussion of the issue addressed above is available at:  Using a Macro to Replace Text Wherever It Appears in a Document

Accepting the issues discussed above, my approach to employing Word field macros is to start with a "universal" procedure that will process the entire document.  With this as the starting point I can then insert calls to specific "actionable" procedures that act on the targeted fields. The basic universal procedure is provided below.

VBA Script:
Public Sub UniversalFieldMacro()
Dim rngStory As Word.Range
Dim lngLink As Long
Dim oShp As Shape
  lngLink = ActiveDocument.Sections(1).Headers(1).Range.StoryType
  For Each rngStory In ActiveDocument.StoryRanges
    'Iterate through all linked stories
    Do
      On Error Resume Next
      'Insert call to action procedure here
      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
                'Insert call to action procedure here
              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 rngStory
lbl_Exit:
  Exit Sub
End Sub

Site Note icon See: Installing Macros for instructions on how to set up and use the macros provided in this Microsoft Word Help & Microsoft Word Tips page.

If you study the code Reading gif, you should see that each stroyrange, linked storyrange and troubled shape TextFrame is processed and a Word field will have nowhere to hide.

Targeting Fields with VBA

Fields are an object and therefore a countable item in any given range.  If you pass a range containing one or more fields as an argument to a VBA procedure, you can then delete all of the fields contained in that range.

VBA Script:
Sub FieldsDeleteAll(ByRef oTargetRng As Range)
  With oTargetRng.Fields
    While .Count > 0
      .Item(1).Delete
    Wend
  End With
lbl_Exit:
  Exit Sub
End Sub

Combining the procedure above with the universal field macro, you can delete all fields in a document.

VBA Script:
Public Sub UniversalFieldMacro()
Dim rngStory As Word.Range
Dim lngLink As Long
Dim oShp As Shape
  lngLink = ActiveDocument.Sections(1).Headers(1).Range.StoryType
  For Each rngStory In ActiveDocument.StoryRanges
    'Iterate through all linked stories
    Do
      On Error Resume Next
      'Call actionable procedure
      FieldsDeleteAll rngStory
      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
                'Call actionable procedure
                FieldsDeleteAll oShp.TextFrame.TextRange
              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 rngStory
lbl_Exit:
  Exit Sub
End Sub

Sub FieldsDeleteAll(ByRef oTargetRng As Range)
  With oTargetRng.Fields
    While .Count > 0
      .Item(1).Delete
    Wend
  End With
lbl_Exit:
  Exit Sub
End Sub

Perhaps you don't want to delete all fields.  You may only want to delete a particular type field.  To do this you simply create an actionable procedure targeting only a specific field (or fields)and call it using the universal macro.

VBA Script:
Sub DeleteAllSpecificFields(ByRef oTargetRng As Range)
Dim oFld As Word.Field
  For Each oFld In oTargetRng.Fields
    Select Case oFld.Type
      Case wdFieldPage
        oFld.Delete
      Case Else
        'Do nothing
     End Select
  Next oFld
lbl_Exit:
  Exit Sub
End Sub

Then there is the case when you may only want to delete fields in specific storyrange (e.g., headers or footers).  It can start to get complicated, but again you can use the universal macro to call a carefully crafted actionable procedure.

VBA Script:
Public Sub UniversalFieldMacro()
Dim rngStory As Word.Range
Dim lngLink As Long
Dim oShp As Shape
  lngLink = ActiveDocument.Sections(1).Headers(1).Range.StoryType
  For Each rngStory In ActiveDocument.StoryRanges
    'Iterate through all linked stories
    Do
      On Error Resume Next
      'Call actionable procedure
      'FieldsDeleteAll rngStory
      'DeleteAllSpecificFields rngStory
      DeleteAllSpecificFieldsInSpecifStoryRange rngStory, wdPrimaryFooterStory
      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
                'Call actionable procedure
                'FieldsDeleteAll oShp.TextFrame.TextRange
                'DeleteAllSpecificFields rngStory
              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 rngStory
lbl_Exit:
  Exit Sub
End Sub

Sub DeleteAllSpecificFieldsInSpecifStoryRange(ByRef oTargetRng As Range, lngStoryType As Long)
Dim oFld As Field
Dim oShp As Shape
  Select Case oTargetRng.StoryType
    Case lngStoryType
      For Each oFld In oTargetRng.Fields
        Select Case oFld.Type
          Case wdFieldPage
             oFld.Delete
          Case Else
            'Do nothing
        End Select
      Next oFld
      Select Case lngStoryType
        Case 6, 7, 8, 9, 10, 11
          If oTargetRng.ShapeRange.Count > 0 Then
            For Each oShp In oTargetRng.ShapeRange
              If oShp.TextFrame.HasText Then
                For Each oFld In oShp.TextFrame.TextRange.Fields
                  Select Case oFld.Type
                    Case wdFieldPage
                    oFld.Delete
                  Case Else
                    'Do nothing
                End Select
                Next oFld
              End If
            Next oShp
          End If
        Case Else
          'Do nothing
      End Select
    Case Else
     'Do nothing
  End Select
lbl_Exit:
  Exit Sub
End Sub

Site Note IconIn the code posted above, notice in the universal macro that the actionable procedure is only called in the main For Each rngStory ... Next loop and not repeated in the For Each oShp ... Next loop. This is because shaped (even shapes in the header and footers have their own storytype definition). Processing of the header and footer storyrange shapes is incorporated in the actionable procedure.

Special Cases:

Some Word fields themselves target a collection.  For example, the DocProperty field shown below returns the value of a targeted property "Author" in the document properties collection.

field_macros_1

If you need to target a specific target in a specific field then you can use a customized VBA procedure to peel back another layer of the onion and look a the field code.

Site Note IconGiven the unlikelihood that the field used in this example will be located in a shape in the header or footer, I've simplified the procedure by eliminating the code required to handle that situation.

VBA Script:
Sub TargetSpecificTargetInSpecificFields()
Dim rngStory As Word.Range
Dim oFld As Word.Field
Dim iLink As Long
  iLink = ActiveDocument.Sections(1).Headers(1).Range.StoryType
  For Each rngStory In ActiveDocument.StoryRanges
    Do
      For Each oFld In rngStory.Fields
        Select Case oFld.Type
          Case wdFieldDocProperty
            'Dig a little deeper and see what the field code contains.
            If InStr(oFld.Code.Text, "Author") Then
              oFld.Unlink
            End If
          Case Else
            'Do nothing
        End Select
      Next
      Set rngStory = rngStory.NextStoryRange
    Loop Until rngStory Is Nothing
  Next
lbl_Exit:
  Exit Sub
End Sub

General Field Action Macro

This section shows you how you can target all fields with a general actionable procedure and delete, lock, unlink, update, or unlock all fields in a document using the universal field macro.

VBA Script:
Sub FieldsActionAll(ByRef oTargetRng As Range, strAction As String, Optional bLocked As Boolean = False)
  'Action is passed as an argument by the calling universal field macro.
  'Example calls:
  1. In the For Each rngStory ... Next loop: FieldsActionAll rngStory, "Update"
  2. In the For Each oShp ... Next loop: oShp.TextFrame.TextRange, "Update"
  Select Case strAction
    Case "Update"
      oTargetRng.Fields.Update
    Case "Unlink"
      oTargetRng.Fields.Unlink
    Case "Locked"
      'Takes the optional argument
      oTargetRng.Fields.Locked = bLocked
    'You can pass "Delete" too!!
    Case "Delete"
      With oTargetRng.Fields
        While .Count > 0
          .Item(1).Delete
        Wend
      End With
  End Select
lbl_Exit:
  Exit Sub
End Sub

Site Note IconNote: You should see that the actionable procedure shown eliminates the need for a specific actionable procedure Sub FieldsDeleteAll() demonstrated earlier!!

Leverage VBA Calls & Arguements

In the previous examples you saw how the universal field macro was used to call and pass arguments to the actionable procedures.  Taking this a step further, you can call and pass arguments to the universal field macro making it the middle man for one or more field actions you may want to perform.

For example, I've assigned the keyboard shortcut F9 to the procedure FieldsUpdateAll shown below.  By revising the UniversalFieldMacro to take an argument, I can simply press F9 and all fields in my document are updated.

VBA Script:
Sub FieldsUpdateAll()
  UniversalFieldMacro "Update"
lbl_Exit:
  Exit Sub
End Sub

Public Sub UniversalFieldMacro(ByRef strAction As String)
Dim rngStory As Word.Range
Dim lngLink As Long
Dim oShp As Shape
  lngLink = ActiveDocument.Sections(1).Headers(1).Range.StoryType
  For Each rngStory In ActiveDocument.StoryRanges
    'Iterate through all linked stories
    Do
      On Error Resume Next
      'Call actionable procedure
      FieldsActionAll rngStory, strAction
      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
                'Call actionable procedure
                FieldsActionAll oShp.TextFrame.TextRange, strAction
              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 rngStory
lbl_Exit:
  Exit Sub
End Sub

Other Custom Field Macros

I'll use this space to post custom field macros that I've created or found interesting.

VBA Script:
Public Sub ConstructFieldsWithVBA()
Dim oRng As Range
Dim oFooterRng1 As Range
Dim oFooterRng2 As Range
  Set oRng = ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range
  With oRng
    .Text = "IF PAGE = ""1""""""PAGE"
    Set oFooterRng1 = .Duplicate
    Set oFooterRng2 = .Duplicate
  End With
  'Insert the field code around the complete expression
  fInsertFields oFooterRng1, "IF PAGE = ""1""""""PAGE"
  'Insert the field code around the Page expressions
  fInsertFields oFooterRng2, "PAGE"
  oRng.Fields.Update
  ActiveWindow.View.ShowFieldCodes = False
lbl_Exit:
  Exit Sub
End Sub

Public Sub fInsertFields(oRng As Range, Optional strText As String)
  With oRng
    'Find the expression and add a field around it
    With .Find
      .Text = strText
      .MatchCase = True
      While .Execute
        oRng.Fields.Add oRng, wdFieldEmpty, , False
        oRng.Collapse wdCollapseEnd
      Wend
    End With
  End With
lbl_Exit:
  Exit Sub
End Sub

That's it for now! I hope you have found this tips page useful and informative.  You can download a Word 2003 document containing all the code examples shown above: Field Macros.

Share

PAYMENTS/DONATIONS

Click to acces PayPal Verification Service Click to acces PayPal Verification Service

Do you want to make a payment for consulting work or donate to help support this site?

PayPal is a safe, easy way to pay online.

Use the appropriate currency "Donate" button to make a payment or donation.


Search my site or the web using Google Search Engine

Google Search Logo