Поиск имён собственных и указание на них при помощи комментария

Прошу прощения. Текст сообщения почему-то при вставке скомкался и обрезался. 

Мне кажется, что вам хватит поиска по тексту без долгого перебора. Не знаю, что вы имеете в виду под "комментарием", но вот этот код добавит "примечания". Не совсем понял про начало предложения, но если только с прописной игнорировать, то это легче лёгкого.

Sub Макросс1()
'Поиск слов с заглавной
Application.ScreenUpdating = False
Selection.HomeKey Unit:=wdStory
sText = "[А-Я][а-я]{1;}"
With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Wrap = wdFindContinue
    .Forward = True
    .MatchWildcards = True
    .Text = sText
    Do While .Execute = True
        Selection.Comments.Add Range:=Selection.Range: ActiveWindow.Panes(2).Close
    Loop
End With
Application.ScreenUpdating = True
End Sub

Доброго времени суток!
  Получился скрипт выполняющий некоторые, ранее озвученные, требования, в частности:
   1) Слова с большой буквы стоящие в начале предложения игнорируются.
   2) Не отмечаются слова со строчной буквы длинной в один символ.
Но пока не получается составить регулярное выражение, чтобы аббревиатуры типа -  ОИРК, БВС   помечались "примечаниями" и скрипт находил слова с прописной буквы стоящие в кавычках (как "ёлочках",  так и "лапках"). Подскажите решение этой проблемы?

Sub ИменаСобственные ()
 Dim sText As String
  Application.ScreenUpdating = False    'Не обновлять страницы после каждого действия
  Selection.HomeKey Unit:=wdStory       'Перемещаемся в начало текста
 sText = "[ ]{1;3}[А-Я][а-я]{1;}"

 With Selection.Find
    .ClearFormatting                    'Сбросить форматирование из предыдущих операций поиска
    .Replacement.ClearFormatting        'Очистить атрибуты поля "Заменить"
    .Wrap = wdFindContinue
    .Forward = True
    .MatchWildcards = True
    .text = sText
      Do While .Execute = True
        'Если перед выделением стоит точка, то это начало предложения, и оно игнорируется
        If Application.Selection.Previous <> "." Then
          Selection.Comments.Add Range:=Selection.Range, text:="Возможно это имя собственное."
        End If
      Loop
 End With
 'Включить обновление экрана после каждого события
 Application.ScreenUpdating = True
End Sub

Здравствуйте!
  Прошу прощения, что долго не отвечал. Про необходимость разбора текста...
Данный пример текста в приатаченном файле повествует о железнодорожной тематике.
В тексте зелёным цветом выделено, то что правильно, красным цветом - ошибки.
Когда речь идёт о железнодорожных горках, то наименования горок должны быть сокращены до одного заглавного (первого) символа взятого в кавычки ёлочки (т.е. ключевое слово -
гор|ки|ок|ка  и т.п.).
Когда речь идёт о станции, то наименование станции должно быть сокращены до одного заглавного символа с большой буквы, без кавычек.
В примере примечания А2 кавычки должны быть не "лапки", а "ёлочки".
В примере примечания А3 нужны кавычки "ёлочки".
Абревиатуры типа "ПТО" и "ЛХ" должны игнорироваться.
Наименование перегона должно быть сокращено до одной первой заглавной буквы, как и "Новосибирск-Западный" должно выглядеть как Н-З.
Наименование  парк|ов|и|а и т.п. (где символ - "|" означает - "или" ) “Б” должно быть в кавычках - "ёлочки", но не лапки.
Прочие имена собственные должны быть сокращены до одной первой заглавной буквы (например: "реку Обь" -  должно выглядеть как "реку О").
Похоже, что мне с таким заданием самому не справиться. Не могли бы Вы мне помочь?