1 Тема от e2027191 (изменено: e2027191, 2014-03-11 06:39:50)

  • e2027191
  • Участник
  • Неактивен

Тема: VBA: Тело письма вставляется после подписи

Алгоритм моих действий:
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

Sub SetSignature(itm, signName)
    If signName <> "" Then
        itm.GetInspector.CommandBars.Item("Insert").Controls("&Подпись").Controls(signName).Execute
    End If
End Sub

Function AddTextToHtml(text, html) As String
    strStamp = "<p class=MsoNormal>" & 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

Function OpenTemplate(path) As Outlook.MailItem
    Dim Item As Outlook.MailItem
    Set Item = Application.CreateItemFromTemplate(path)
    Set OpenTemplate = Item
End Function