Sub Macro1()
ReplaceWithDocVar "Mary", "TheName"
End Sub


Sub ReplaceWithDocVar(strFind As String, strVarName As String)
Dim oStory As Range
    For Each oStory In ActiveDocument.StoryRanges
        With oStory.Find
            Do While .Execute(FindText:=strFind, MatchWholeWord:=True)
                oStory.Text = ""
                oStory.Fields.Add Range:=oStory, _
                                  Type:=wdFieldDocVariable, _
                                  Text:=Chr(34) & strVarName & Chr(34), _
                                  PreserveFormatting:=True
                oStory.Collapse 0
            Loop
        End With
        If oStory.StoryType <> wdMainTextStory Then
            While Not (oStory.NextStoryRange Is Nothing)
                Set oStory = oStory.NextStoryRange
                With oStory.Find
                    Do While .Execute(FindText:=strFind, MatchWholeWord:=True)
                        oStory.Text = ""
                        oStory.Fields.Add Range:=oStory, _
                                          Type:=wdFieldDocVariable, _
                                          Text:=Chr(34) & strVarName & Chr(34), _
                                          PreserveFormatting:=True
                        oStory.Collapse 0
                    Loop
                End With
            Wend
        End If
    Next oStory
    Set oStory = Nothing
lbl_Exit:
    Exit Sub
End Sub