Помогаю решить внутренние конфликты (konst_kuzmin) wrote in ms_outlook,
Помогаю решить внутренние конфликты
konst_kuzmin
ms_outlook

Обращаемся ко всем по именам в электронных письмах MS Outlook 2007

Этот пост нудный. Вы, конечно же, быстро набираете руками, и можете набирать обращение к человеку каждый раз, как пишите ему письмо, Вас же это совсем не затрудняет. И опечаток в имени Вы не совершаете. А если и есть у Вас необходимость автоматизировать подстановку имен, то Вы умеете писать программы на Visual Basic Application и сам это сделаете – зачем заниматься «археологическими раскопками» чужого кода? Согласны со всем этим? Тогда дальше можете не читать.

Те, кто стремится получить максимально быстро результат, могут попробовать прочитать код непосредственно. Программа комментировалась по максимуму. По максимуму в моем понимании этого максимума. Если осталось недопонимание, или Вы предпочитаете все делать планомерно – читайте «Идея в 2х словах». О том как пришла идея написать и как проходил процес, если это кому-то интересно см. «Историческая справка».

С удовольствием отвечу тем, кто прокоментирует по сути. За явный офтоп - удаление и бан без предупреждений.

Примечание для не знакомых с тем, где у Microsoft находятся автозапускаемые макросы:
Заходим в меню «Сервис\Макрос\Редактор Visual Basic» находим «ThisOutlookSession» щелкаем двойным щелчком и вставляем код программы в открывшееся окно редактора.



Код программы
Название надо оставить без изменений!
Private Sub Application_ItemSend(ByVal Item As Object, _
Cancel As Boolean)
    Dim recip As Recipient
    Dim ii As Integer
    Dim Papkaest As Boolean
    
'    Добавляет слова "Добрый день" и обращение
    ' проверяет не добавлены ли уже слова добрый день с самого начала и после 2 энтеров
    If (Not Item.Body Like "Добрый день*") And _
    (Not Item.Body Like Chr(160) + Chr(13) + Chr(10) + Chr(13) + Chr(10) + _
    Chr(160) + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "Добрый день*") Then
        Dim Privet As String
        Dim Papka As Folder
        Dim zametka As NoteItem
        Dim Obr As String
        
        Privet = "Добрый день, "
        ' открывает папку заметок "Обращения"
        For Each Papka In Application.Session.GetDefaultFolder(olFolderNotes).Folders
            If Papka.Name = "Обращения" Then
                
                Papkaest = True
                Exit For
            End If
            
        Next
        'создает папку заметок "Обращения", если ее нет
        If Not Papkaest Then
            If MsgBox("Папки " + Chr(34) + "Обращения" + Chr(34) + " нет. Без нее работа программы по добавлению приветствия невозможна. Создать такую?", vbYesNo) = vbYes Then
                Set Papka = Application.Session.GetDefaultFolder(olFolderNotes).Folders.Add("Обращения")
            Else
                GoTo exi
            End If
        End If
        For Each recip In Item.Recipients
            If recip.Type = 1 Then
                Obr = ""
                ' проверяет наличие обращения и присваивает переменную Obr
                For Each zametka In Papka.Items
                    If zametka.Body Like recip.AddressEntry.Address + "*" Then
                        Obr = Right(zametka.Body, Len(zametka.Body) - InStr(1, zametka.Body, "; ") - 1)
                        If InStr(1, Obr, "; ") <> 0 Then Obr = Left(Obr, InStr(1, Obr, "; ") - 1)
                        Exit For
                        'InStr(InStr(1,zametka.Body, "; ")+1,zametka.Body, "; ")
                    End If
                Next
                ' получения приветствия, если его нет в заметках
                If Obr = "" Then
                    ii = MsgBox("Нет имени для адресса: " + recip.AddressEntry.Address + _
                    " Да - отправить без имени, Нет - попробовать найти имя в контактах, Отмена - ввести имя вручную", vbYesNoCancel)
                    If ii = vbNo Then
                    'поиск
                        Dim oCont As ContactItem
                        For Each oCont In Application.Session.GetDefaultFolder(olFolderContacts).Items
                            If oCont.Class = olContact Then
                                If oCont.Email1Address = recip.AddressEntry.Address _
                                Or oCont.Email2Address = recip.AddressEntry.Address _
                                Or oCont.Email3Address = recip.AddressEntry.Address Then
                                    Obr = oCont.FirstName + " " + oCont.MiddleName
                                    Exit For
                                End If
                            End If
                        Next
                    End If
                    'добавление заметки
                        Set zametka = Papka.Items.Add
                Else
                    GoTo sliyan
                End If
                    'подтверждение правильности имени и внесение изменений в заметку
                    If Not ii = vbYes Then

                        Obr = InputBox("Введите имя, которое будет использоваться для адреса: " + _
                        recip.AddressEntry.Address, , Obr)
                    End If
                    If Obr = "" Then
                        If MsgBox("Отправить без добавления приветствия?", vbYesNo) = vbNo Then Cancel = True
                        zametka.Delete
                        GoTo exi
                    Else
                        zametka.Body = recip.AddressEntry.Address + "; " + Obr
                        zametka.Close olSave
                    End If
sliyan:
                    Privet = Privet + Obr + ", "
            End If
        Next
        'добавляет восклицательный знак в конец
        
        Privet = Left(Privet, Len(Privet) - 2) + "!"
        'подставляет союз "и" перед последним, если больше 1 имени соединено
        If InStrRev(Privet, ", ") > 12 Then _
        Privet = Left(Privet, InStrRev(Privet, ", ") - 1) + Replace(Privet, ", ", " и ", InStrRev(Privet, ", "))
       
        'собственно добавление приветствия
            Item.BodyFormat = olFormatHTML
            Item.HTMLBody = "<font face=" & Chr(34) & " arial"="arial"" &="&" chr(34)="Chr(34)" &="&" "="""> " + Privet + " 

" + Item.HTMLBody 'оставление письма без отправки чтобы юзер мог убедиться в правильном форматировании Cancel = True 'End If End If End If exi: If Item.Subject = "" Then If Item.Attachments.Count > 0 Then Item.Subject = InputBox("Добавить тему", , Item.Attachments.Item(1).FileName) If Item.Subject = "" Then If MsgBox("Отправить без темы?", vbYesNo) = vbNo Then Cancel = True End If End If End Sub
</font>
  • Post a new comment

    Error

    default userpic

    Your IP address will be recorded 

  • 14 comments
Plain and simple! I like your work!

seonickname

Anonymous

May 10 2011, 21:13:27 UTC 5 years ago

Интересная статья. Ретвитнул*)
спасибо

seoblya

Anonymous

May 11 2011, 09:45:46 UTC 5 years ago

Подписался по RSS и ретвитнул
любопытно, а можно в личку ссылочку на твитер?

seoblya

Anonymous

May 11 2011, 12:05:43 UTC 5 years ago

А у Вас есть подписка на обновление сайта по e-mail?
Ага, см. самый верхний пост http://kuzmin-lj.livejournal.com/5227.html . только я ушел от тематики софта, программирования. И не планирую пока возвращаться.
Строки

...Item.HTMLBody = "
[Error: Irreparable invalid markup ('<font [...] ">') in entry. Owner must fix manually. Raw contents below.]

Строки

...Item.HTMLBody = "<font face=" & Chr(34) & " arial"="arial"" &="&" chr(34)="Chr(34)" &="&" "="""> " + Privet + "

" + Item.HTMLBody...

красит красным. При попытке выполнить макрос, ругается Invalid Procedure Name.
Что я делаю не так?
Макрос не надо выполнять. Если он в правильном месте и с правильным названием - запускается сам по кнопке отправить.
как я понимаю, находится он в правильном месте - Application_ItemSend...
Не могу понять, где же название.
Вот это: Application_ItemSend(ByVal Item As Object, _
Cancel As Boolean)
?
Заходим в меню «Сервис\Макрос\Редактор Visual Basic» находим «ThisOutlookSession» щелкаем двойным щелчком и вставляем код программы в открывшееся окно редактора.

Это не отдельный макрос! Программа в ThisOutlookSession

Первое - захватывает отправляемое сообщение. Второе если переключить на истина - оно не отправится.
"Заходим в меню «Сервис\Макрос\Редактор Visual Basic» находим «ThisOutlookSession» щелкаем двойным щелчком и вставляем код программы в открывшееся окно редактора."
- так и сделал.
Объясните, пожалуйста, дальнейший порядок действий.
1. Создаем сообщение, 2. выбираем в форме сообщения контакт через кнопку "кому", 3. нажимаем "отправить"?..

Или как правильно?
"Заходим в меню «Сервис\Макрос\Редактор Visual Basic» находим «» щелкаем двойным щелчком НА ThisOutlookSession (!) и вставляем код программы в открывшееся окно редактора."

щелкаем двойным щелчком НА ThisOutlookSession (!)

Если при нажатии отправить не запускается программа - значит что-то не то. Макросы выключены или еще что-то. Можно попробовать аутлук перегрузить.

Deleted comment

не знаю... я забросил этот проект и программирование вообще. В ближайшую неделю вряд ли найду время копаться в коде...