Outlook. Шаблон для нового сообщения

[ru3000]

Здравствуйте. Пишу про Outlook в тему для Exel, т.к. она ближе всего по духу в среде создания макросов.
У Outlook есть такая болячка как отсутствие вменяемой работы с шаблонами. Казалось бы какой пустяк сделать шаблон, чтобы при создании нового сообщения в тело письма вставлялось слово "Здравствуйте", а ниже вставлялась подпись. Но не тут-то было. Платный продукт Outlook вырос уже до великого и ужасного релиза 2013, а так и не научился у своих бесплатных конкурентов элементарным функциям.
Вариант - вставить слово "Здравствуйте" в саму подпись - не канает, т.к. в этом случае придется писать письмо в поле предназначенном для подписи, где нельзя полноценно редактировать.
Так же можно сохранить шаблон письма на компьютер и потом вызывать его специальным макросом каждый раз когда нужно написать письмо. Это пожалуй будет самый правильный и красивый вариант (особенно если повесить разноцветные кнопочки этих макросов на ленту), но он выгоден когда необходимо работать с большим количеством шаблонов. В случае, когда нужно вставить только лишь слово "Здравствуйте" в каждое новое письмо, нагромождать панель лишними кнопками и переобучать сотрудников нажимать не на кнопку "Создать сообщение" к которой они привыкли, а на "вон ту новую красивенькую кнопочку" как-то не комильфо. Пользователи, как известно, народ ушлый, но труднопереобучаемый. Да и переделывание ленты в Outlook для 100 пользователей не прельщает свой перспективой.
Порыскав ночку в интернетах нашел с виду неплохой макрос под свои нужды (вставлять макрос нужно в ThisOutlookSession предварительно разрешив выполнение макросов в параметрах безопасности Outlook).

Private WithEvents m_Inspectors As Outlook.Inspectors
Private WithEvents m_Inspector As Outlook.Inspector

Private Sub Application_Startup()
  Set m_Inspectors = Application.Inspectors
End Sub

Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
  Set m_Inspector = Inspector
End Sub

Private Sub m_Inspector_Activate()
  With m_Inspector.CurrentItem
    .HTMLBody = "Здравствуйте." & "<br>" & .HTMLBody
  End With
End Sub

И вроде срабатывает этот макрос как надо, даже при ответе и пересылке подставляется слово "Здравствуйте" и подпись, которая создана заранее обычными средствами Outlook. Но есть один неприятный момент который никак не могу победить - макрос срабатывает каждый раз когда идет обращение к редактируемому письму. Т.е. сколько раз закрыл-открыл черновик или просто кликнул правой кнопкой мыши в письме столько раз и вставляется слово "Здравствуйте".
И еще один момент - макрос работает только если редактируемое письмо открыто в новом окне, а не в теле основного окна Outlook. Но это не смертельно, просто нужно учитывать это при настройке Outlook для работы с этим макросом (настраивается в параметрах Outlook "Ответы и пересылка").

Так вот собственно сам вопрос - как научить данный макрос определять что в редактируемом письме в начале текста уже есть слово "Здравствуйте" и останавливаться если это слово найдено?
Заранее спасибо за любую помощь.

PS: Использую Outlook 2013 x64

[ru3000]

Нашел то что хотел. Теперь макрос проверяет наличие слова "Здравствуйте". Если такое слово есть, то макрос останавливается. Правда теперь в ответах и пересылках макрос может и не вставлять приветствие если в письме он найдет хоть одно слово "Здравствуйте". Временное решение - добавил в конце вставляемого и искомого слова точку и пробел, дабы хоть немного сократить вероятность совпадения. Также добавил форматирование к слову "Здравствуйте", в данном примере: шрифт Calibri, размер 11.

Private WithEvents m_Inspectors As Outlook.Inspectors
Private WithEvents m_Inspector As Outlook.Inspector

Private Sub Application_Startup()
  Set m_Inspectors = Application.Inspectors
End Sub

Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
 Set m_Inspector = Inspector
End Sub

Private Sub m_Inspector_Activate()
  If InStr(m_Inspector.CurrentItem.Body, "Здравствуйте. ") Then
    Exit Sub
  Else
  With m_Inspector.CurrentItem
    .HTMLBody = "<span style=font-family:Calibri;font-size:11pt>Здравствуйте. </span>" & "<br>" & .HTMLBody
  End With
  End If
End Sub

[Step_UA]

Функция InStr возвращает позицию найденной строки - проверяйте ее ...

  With m_Inspector.CurrentItem
    If InStr(.Body, "<span style=font-family:Calibri;font-size:11pt>Здравствуйте.</span><br>") <> 1 Then _
        .HTMLBody = "<span style=font-family:Calibri;font-size:11pt>Здравствуйте.</span><br>" & .HTMLBody
  End With

[ru3000]

Спасибо. Теперь все работает как надо. Вот рабочий вариант макроса.

Private WithEvents m_Inspectors As Outlook.Inspectors
Private WithEvents m_Inspector As Outlook.Inspector

Private Sub Application_Startup()
  Set m_Inspectors = Application.Inspectors
End Sub

Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
 Set m_Inspector = Inspector
End Sub

Private Sub m_Inspector_Activate()
  With m_Inspector.CurrentItem
    If InStr(.Body, "Здравствуйте") <> 1 Then _
      .HTMLBody = "<span style=font-family:Calibri;font-size:11pt>Здравствуйте.</span><br>" & .HTMLBody
  End With
End Sub

[ru3000]

Outlook 2013 при ответе и пересылке по умолчанию использует синий цвет текста в теле письма. Чтобы учесть этот момент я немного доработал макрос. Теперь макрос будет проверять нет ли в письме слова "From:". Если нет, то в письмо будет вставлено слово "Здравствуйте" с автоматическим (черным) цветом. Если есть, то слово "Здравствуйте" будет окрашено в синий цвет (color:#205080).

Private WithEvents m_Inspectors As Outlook.Inspectors
Private WithEvents m_Inspector As Outlook.Inspector

Private Sub Application_Startup()
  Set m_Inspectors = Application.Inspectors
End Sub

Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
 Set m_Inspector = Inspector
End Sub

Private Sub m_Inspector_Activate()
  With m_Inspector.CurrentItem
    If InStr(.Body, "Здравствуйте") <> 1 Then
      If InStr(.Body, "From:") = 0 Then _
        .HTMLBody = "<span style=font-family:Calibri;font-size:11pt>Здравствуйте.</span><br>" & .HTMLBody
      If InStr(.Body, "From:") > 0 Then _
        .HTMLBody = "<span style=font-family:Calibri;font-size:11pt;color:#205080>Здравствуйте.</span><br>" & .HTMLBody
    End If
  End With
End Sub

[AMukhanin]

Ох, Спасибо, дорогой товарищ! )))

Очень помог!

[AMukhanin]

Сообщение от ru3000

Outlook 2013 при ответе и пересылке по умолчанию использует синий цвет текста в теле письма. Чтобы учесть этот момент я немного доработал макрос. Теперь макрос будет проверять нет ли в письме слова "From:". Если нет, то в письмо будет вставлено слово "Здравствуйте" с автоматическим (черным) цветом. Если есть, то слово "Здравствуйте" будет окрашено в синий цвет (color:#205080).

Private WithEvents m_Inspectors As Outlook.Inspectors
Private WithEvents m_Inspector As Outlook.Inspector

Private Sub Application_Startup()
  Set m_Inspectors = Application.Inspectors
End Sub

Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
 Set m_Inspector = Inspector
End Sub

Private Sub m_Inspector_Activate()
  With m_Inspector.CurrentItem
    If InStr(.Body, "Здравствуйте") <> 1 Then
      If InStr(.Body, "From:") = 0 Then _
        .HTMLBody = "<span style=font-family:Calibri;font-size:11pt>Здравствуйте.</span><br>" & .HTMLBody
      If InStr(.Body, "From:") > 0 Then _
        .HTMLBody = "<span style=font-family:Calibri;font-size:11pt;color:#205080>Здравствуйте.</span><br>" & .HTMLBody
    End If
  End With
End Sub

Как уже говорил - Спасибо.

НО
обнаружилась ошибка при открытии вложенных писем или входящих писем - в них вставляется наше "Здрасте"...

Не уверен, что сделал правильно, но мои "костыли" вроде работают... )))) Надо еще тестировать...
Если у кого-то есть более корректный или элегантный вариант, дайте знать ))

Итак, у меня такой код получился:

Private Sub m_Inspector_Activate()
Dim value As Date
On Error Resume Next
value = m_Inspector.CurrentItem.CreationTime
If value <> "01.01.4501" Then Exit Sub            ' думаю, что эта проверка на Создание НОВОГО письма... 

txt_hi = "Коллеги, добрый день."
  With m_Inspector.CurrentItem
    If InStr(.Body, txt_hi) <> 1 Then
    On Error Resume Next
        .HTMLBody = "<span style=font-family:Arial;font-size:10pt;color:#205080>" & txt_hi & "</span>" & "<br>" & .HTMLBody
    End If
  End With
End Sub

[Vestigator]

Всем привет! Большое спасибо за код. Слегка переделал - Меняет приветствие в зависимости от времени. Но возникла проблема, при изменении в Outlook 2010 контактов, VBA дает ошибку на

.HTMLBody = "<span style=font-family:Arial;font-size:14pt>Добрый день!</span><br>" & .HTMLBody

Я так понял, что проблемы в том, что при измении контактов вызывается событие и не может вставить текст в body))).
Вот весь код.

Private WithEvents m_Inspectors As Outlook.Inspectors
Private WithEvents m_Inspector As Outlook.Inspector

Private Sub Application_Startup()
  Set m_Inspectors = Application.Inspectors
End Sub

Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
 Set m_Inspector = Inspector
End Sub

Private Sub m_Inspector_Activate()
Dim x As Long
x = Timer()
Select Case x
Case Is < 43200
  With m_Inspector.CurrentItem
    If InStr(.Body, "Доброе утро!") <> 1 Then
      If InStr(.Body, "From:") = 0 Then _
        .HTMLBody = "<span style=font-family:Arial;font-size:14pt>Доброе утро!</span><br>" & .HTMLBody
      If InStr(.Body, "From:") > 0 Then _
        .HTMLBody = "<span style=font-family:Arial;font-size:14pt;color:#205080>Доброе утро!</span><br>" & .HTMLBody
    End If
  End With
Case Is >= 43200, Is < 64800
    With m_Inspector.CurrentItem
    If InStr(.Body, "Добрый день!") <> 1 Then
      If InStr(.Body, "From:") = 0 Then _
        .HTMLBody = "<span style=font-family:Arial;font-size:14pt>Добрый день!</span><br>" & .HTMLBody
      If InStr(.Body, "From:") > 0 Then _
        .HTMLBody = "<span style=font-family:Arial;font-size:14pt;color:#205080>Добрый день!</span><br>" & .HTMLBody
    End If
  End With
Case Is >= 64800
    With m_Inspector.CurrentItem
    If InStr(.Body, "Добрый вечер!") <> 1 Then
      If InStr(.Body, "From:") = 0 Then _
        .HTMLBody = "<span style=font-family:Arial;font-size:14pt>Добрый вечер!</span><br>" & .HTMLBody
      If InStr(.Body, "From:") > 0 Then _
        .HTMLBody = "<span style=font-family:Arial;font-size:14pt;color:#205080>Добрый вечер!</span><br>" & .HTMLBody
    End If
  End With
End Select
End Sub