SELECT * FROM Vzakladke.net

Статьи об автоматизации и программировании


VBA Подстановка имен из нового исходящего сообщения в Outlook (настройка обращения по адресатам рассылки)

 

 

Сегодня мы рассмотрим скрипт для настройки обращения по адресатам рассылки, то есть займемся подстановкой имен из нового исходящего сообщения в Outlook. Бывает такое, что хочется полениться и нажимать просто одну кнопку, нежели лезть в поле ввода адресов и копировать оттуда сложные имена и отчества для обращения по адресатам рассылки. В этом нам поможет VBA. Теперь нажимайте ALT + F11, мы перейдем в раздел разработчика.

В начале нам необходимо научиться находить имя и отчество. Смотрим и копируем код:

'функция выделения  имени и отчества
Public Function ФИ(ФИО, Optional Наоборот As Boolean = False)
Dim Ф As String 'фамилия, выделенная из ФИО
Dim ИО As String 'инициалы, выделенные из ФИО
Dim i As Long 'счётчик
    ФИ = ФИО 'гарантируем возврат данных
    If IsNull(ФИО) Then Exit Function 'выходим из-за пустого значения ФИО
    ФИО = Trim(ФИО) 'отсекаем пробелы спереди и сзади
    If Len(ФИО) < 3 Then Exit Function 'выходим из-за малой длины ФИО
    i = InStr(ФИО, " ") 'ищем первый пробел
    If i = 0 Then Exit Function 'выходим ввиду отсутствия пробелов
    Ф = Left(ФИО, i) 'выделяем фамилию
    ИО = Right(ФИО, Len(ФИО) - i) 'выделяем имя и отчество
    ФИ = ИО 'возвращаем имя и отчество
End Function
 

Теперь мы научимся добавлять приветствие к письму:

Sub MsgAddImena()
Set myItem = Application.ActiveInspector
Set objItem = myItem.CurrentItem
Dim strTemp As String

' получим все имена через запятую
strTemp = ""
Dim a() As String
a = Split(objItem.To, "; ")
  For Each strMail In a
   strTemp = strTemp & ", " & ФИ(strMail)
  Next

    'Текущее время.
    Dim h As Integer
    h = DatePart("h", Time)
    '============
    ' Приветствие.
    Dim greeting As String
    Select Case h
        Case Is < 6
            greeting = "Доброй ночи"
        Case Is < 10
            greeting = "Доброе утро"
        Case Is < 18
            greeting = "Добрый день"
        Case Is < 22
            greeting = "Добрый вечер"
        Case Else
            greeting = "Доброй ночи"
    End Select
    '============

'Вставить автоответ в начале письма.
objItem.HTMLBody = "<p class=MsoNormal><b><span style='font-size:14.0pt;color:#1F4E79'>" & _
 greeting &  strTemp & "<o:p></o:p></span></b></p>" & objItem.HTMLBody
End Sub

 

Здесь мы из исходящего текущего письма достаем из адресной строки имена тех к кому будем обращаться. 

Здесь же нам не подошла такая строка objItem.HTMLBody = "<h3>Добрый день, " & ФИ(objItem.To) & "</h3>" & objItem.HTMLBody из-за того что надо поменять разделитель ; на запятую, поскольку будет сразу несколько адресатов, мы сможем обратиться сразу ко всем. Для этого преобразуем нашу строку в массив используя функцию split.

 

Если уж нам не очень хочется менять форматирование письма, то попробуем просто скопировать в буфер обмена имена тех к кому обращаемся:

Sub MsgCopyImena ()
Set myItem = Application.ActiveInspector
Set objItem = myItem.CurrentItem
Dim strTemp As String

strTemp = ""
Dim a() As String
a = Split(objItem.To, "; ")
  For Each strMail In a
   strTemp = strTemp & ", " & ФИ(strMail)
  Next

' C:\Windows\SysWOW64\FM20.DLL  - add Library to project for copy
    Dim clipboard As MSForms.DataObject
    Set clipboard = New MSForms.DataObject
    clipboard.SetText Right(strTemp, Len(strTemp) - 1) '"Добрый день" & strTemp & " "
    clipboard.PutInClipboard
End Sub

 

А чтобы код копирования работал добавьте ссылку на библиотеку: C:\Windows\SysWOW64\FM20.DLL

 

Forms Object Library

 

Что осталось сделать, так это добавить нужные кнопки на ленту в исходящем сообщении. Для этого создадим новое сообщение, Далее жмем Файл - Параметры - Настроить ленту. Создаем группу например текст сообщения. Выбираем в командах Макросы и добавляем туда кнопки (и там же можем переименовать их, например "Копировать имена").

 

buttons treatment in outlook

Вуаля! Все готово! Теперь можно меньше напрягаться при написании писем.

 

Дата публикации: 2016-02-08 12:32:15

VBA

2

Отзывы:

Сергей
☢ это бомба!
Антон
Может не совсем корректно, но я бы здоровался проще: Dim st As String F3 = Format(Time, "h") '============ Select Case F3 Case Is >= 18 st = "Добрый вечер" Case Is >= 10 st = "Добрый день" Case Is >= 6 st = "Доброе утро" End Select '============
Денис
Благодарю За код. Активно использую в работе. Подскажите пожалуйста код с помощью которого можно было добавлять определённый текст в конце письма, например: "Жду Вашего ответа". Благодарю.
Дмитрий
Спасибо за положительный отзыв. Полагаю что можно изменить автоответ в теле письма таким образом: objItem.HTMLBody = "<p class=MsoNormal><b><span style='font-size:14.0pt;color:#1F4E79'>" & _ greeting & strTemp & "<o:p></o:p></span></b></p>" & objItem.HTMLBody & "Жду Вашего ответа"
Владимир
Зачётно !!!

Ваше имя:

Ваш e-mail (необязательно):

Сообщение:

Captcha