Setting up a nested field in Word using VBA

Question

I am building a large document in pieces from templates. Each template has a keyword #OVERALLPAGENUMBER# in the footer which I am programmatically replacing (using Excel VBA) with a field.

If all I needed were that document's page number, the following would suffice:

Dim storyRange As Object 'Word.Range
For Each storyRange In oDoc.StoryRanges
    Do
        With storyRange.Find
            .Text = "#OVERALLPAGENUMBER#"
            .Wrap = 1 'wdFindContinue
            .Execute
            While .found
                storyRange.Fields.Add Range:=storyRange, Type:=-1, Text:="PAGE", PreserveFormatting:=True
                .Execute
            Wend
        End With
        On Error Resume Next
        Set storyRange = storyRange.NextStoryRange
        On Error GoTo 0
    Loop While Not storyRange Is Nothing
Next

I've tested this code, and it successfully puts the page number in the footer. What I want, however, is a nested (formula) field which adds a fixed number to the page number so that I can display a page count across multiple documents. My solution, if I do it manually (using Ctrl+F9), gives field codes that look like this:

{ = 5 + { PAGE } }

And correctly produces "6" on page 1, "7" on page 2, etc...

No matter what I try though, I cannot replicate this sort of field nesting using VBA. (Macro recorder is useless here). Can anyone find a way to create these fields programmatically?

---

Solution

My problem was that having PreserveFormatting:=True was getting in the way of my attempts to nest one field within the other. Now the following simple solution works:

With storyRange.Find
    .Text = "#POLICYPAGENO#"
    .Wrap = 1 'wdFindContinue
    .Execute
    While .found
        storyRange.Select
        With oDoc.ActiveWindow
            .Selection.Fields.Add Range:=.Selection.Range, Type:=-1, Text:="PAGE", PreserveFormatting:=False
            .Selection.MoveLeft Unit:=1, Count:=1, Extend:=1
            .Selection.Fields.Add Range:=.Selection.Range, Type:=-1, PreserveFormatting:=False
            .Selection.TypeText Text:="= " & OverallPageNumber & " +"
        End With
        .Execute
    Wend
End With

Answer 1

I'm pretty sure that your method of Find and Replacing will Select the text #OVERALLPAGENUMBER# each time it loops through. If that is the case you can replace storyRange.Fields.Add Range:=storyRange, Type:=-1, Text:="PAGE", PreserveFormatting:=True with the following, which will simply place your required field code at the current selection:

Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
Selection.TypeText Text:="= 5 +"
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
Selection.TypeText Text:="PAGE"
Selection.Fields.Update

Edit: The previous code only works if PreserveFormatting is set to False. It appears that Word updates an empty field code if PreserveFormatting is set to True. You can navigate the selection to keep the formatting with the following. You should only need to PreserveFormatting for the outer field.

Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, PreserveFormatting:=True
Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Selection.Fields.ToggleShowCodes
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText Text:="= 5 +"
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, PreserveFormatting:=False
Selection.TypeText Text:="PAGE"
Selection.Fields.Update

Answer 2

I know this is old, but trying to do this yesterday, I found a simpler solution to creating nested fields than to use the Selection object. The only solutions I found on the web incorrectly say that there's no way to insert nested fields without using the Selection object. However, I found that you can insert a nested field into the Field.Code range, which makes the code easier to manipulate, faster and more intuitive. As in:

Dim storyRange As Object 'Word.Range
For Each storyRange In oDoc.StoryRanges
    Do
        With storyRange.Find
            .Text = "#OVERALLPAGENUMBER#"
            .Wrap = 1 'wdFindContinue
            .Execute
            While .Found
                Set fld1 = storyRange.Fields.Add(Range:=storyRange, Type:=-1, Text:="=p+" & OverallPageNumber, PreserveFormatting:=False)
                Set fld2 = storyRange.Fields.Add(Range:=fld1.Code.Characters(3), Type:=-1, Text:="PAGE", PreserveFormatting:=False)
                fld1.Update
                .Execute
            Wend
        End With
        On Error Resume Next
        Set storyRange = storyRange.NextStoryRange
        On Error GoTo 0
    Loop While Not storyRange Is Nothing
Next