Помогаю решить внутренние конфликты (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>
Subscribe
  • Post a new comment

    Error

    default userpic

    Your IP address will be recorded 

  • 14 comments