none
VBA for Outlook: Тело письма вставляется под подписью RRS feed

  • Общие обсуждения

  • Алгоритм моих действий:

    1. создаю ReplyAll с помощью VBA в Outlook 2010

    2. беру тело письма из заранее определенного шаблона

    3. устанавливаю подпись

    В результате чего на некоторых машинах есть проблема - тело письма идёт после подписи.

    Уважаемые комрады, знает ли кто, как побороть эту проблему?

    Код макросов:

    Sub Reply_finish() 
        path = "\\SHARA\mail_templates\Reply_finish.msg" 
        sName = "Уведомления" 
    
        Dim oApp As New Outlook.Application 
        Dim oSel As Outlook.Selection 
    
        Set oSel = oApp.ActiveExplorer.Selection 
        Dim strMessageClass As String 
    
        Set oItem = oSel.Item(1) 
        strMessageClass = oItem.MessageClass 
        If (strMessageClass = "IPM.Note") Then 
            Set oMailItem = oItem 
            Set reply = oItem.ReplyAll 
            reply.BCC = oItem.BCC 
    
            Set tempItem = OpenTemplate(path) 
            reply.HTMLBody = AddTextToHtml(tempItem.Body, reply.HTMLBody) 
            reply.To = tempItem.To 
            Set tempItem = Nothing 
    
            reply.Display 
    
            Call SetSignature(reply, sName) 
        End If 
    
        Set oApp = Nothing 
        Set oExp = Nothing 
        Set oSel = Nothing 
    End Sub 
    
    ' Функция установки подписи в сообщении
    ' После того, как сообщение было создано и показано в окне,
    ' данная функция ищет в меню открытого окна 
    выбор подписи и выбирает по имени нужную ' itm - MailItem, который был 
    создан и показан
    ' signName - имя подписи, которую нужно выбрать 
    
    Sub SetSignature(itm, signName) 
        If signName <> "" Then 
            itm.GetInspector.CommandBars.Item("Insert").Controls("&Подпись").Controls(signName).Execute 
        End If End Sub 
    
    ' Функция добавления нужного текста в начало тела сообщения
    ' text - нужный текст (для ответа)  
    ' html - HTMLBody объекта, созданного с помощью ReplyAll 
    Function AddTextToHtml(text, html) As String
        strStamp = "<p & text & "<o:p></o:p></p>"
        intTagStart = InStr(1, html, "<body", _     vbTextCompare)
        intTagEnd = InStr(intTagStart + 5, html, ">")
        strBodyTag = _
        Mid(html, _
        intTagStart, intTagEnd - intTagStart + 1)
        AddTextToHtml = Replace(html, strBodyTag, strBodyTag & strStamp)
    End Function 
    
    ' Функция создания письма по шаблону 
    ' path - путь на файловой системе до шаблона
    Function OpenTemplate(path) As Outlook.MailItem
        Dim Item As Outlook.MailItem
        Set Item = Application.CreateItemFromTemplate(path)
        Set OpenTemplate = Item
    End Function

    12 марта 2014 г. 4:29