<?xml version="1.0" encoding="utf-8"?>
<feed xmlns="http://www.w3.org/2005/Atom">
	<title type="html"><![CDATA[Серый форум &mdash; VBA: Тело письма вставляется после подписи]]></title>
	<link rel="self" href="http://forum.script-coding.com/extern.php?action=feed&amp;tid=9348&amp;type=atom" />
	<updated>2014-03-11T02:19:22Z</updated>
	<generator>PunBB</generator>
	<id>http://forum.script-coding.com/viewtopic.php?id=9348</id>
		<entry>
			<title type="html"><![CDATA[VBA: Тело письма вставляется после подписи]]></title>
			<link rel="alternate" href="http://forum.script-coding.com/viewtopic.php?pid=80666#p80666" />
			<content type="html"><![CDATA[<p>Алгоритм моих действий:<br />1. создаю ReplyAll с помощью VBA в Outlook 2010<br />2. беру тело письма из заранее определенного шаблона<br />3. устанавливаю подпись<br />В результате чего на некоторых машинах есть проблема - тело письма идёт после подписи.</p><p>Уважаемые комрады, знает ли кто, как побороть эту проблему?<br />Код макросов в спойлере.<br /></p><div class="fancy_spoiler_switcher"><div class="fancy_spoiler_switcher_header" data-lang-open="открыть спойлер" data-lang-close="скрыть спойлер"><strong>+</strong>&nbsp;открыть спойлер</div><div class="fancy_spoiler"><div class="codebox"><pre><code>
Sub Reply_finish()
    path = &quot;\\SHARA\mail_templates\Reply_finish.msg&quot;
    sName = &quot;Уведомления&quot;
    
    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 = &quot;IPM.Note&quot;) 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 &lt;&gt; &quot;&quot; Then
        itm.GetInspector.CommandBars.Item(&quot;Insert&quot;).Controls(&quot;&amp;Подпись&quot;).Controls(signName).Execute
    End If
End Sub

Function AddTextToHtml(text, html) As String
    strStamp = &quot;&lt;p class=MsoNormal&gt;&quot; &amp; text &amp; &quot;&lt;o:p&gt;&lt;/o:p&gt;&lt;/p&gt;&quot;
    intTagStart = InStr(1, html, &quot;&lt;body&quot;, _
    vbTextCompare)
    intTagEnd = InStr(intTagStart + 5, html, &quot;&gt;&quot;)
    strBodyTag = _
    Mid(html, _
    intTagStart, intTagEnd - intTagStart + 1)
    AddTextToHtml = Replace(html, strBodyTag, strBodyTag &amp; strStamp)
End Function

Function OpenTemplate(path) As Outlook.MailItem
    Dim Item As Outlook.MailItem
    Set Item = Application.CreateItemFromTemplate(path)
    Set OpenTemplate = Item
End Function
</code></pre></div></div></div>]]></content>
			<author>
				<name><![CDATA[e2027191]]></name>
			</author>
			<updated>2014-03-11T02:19:22Z</updated>
			<id>http://forum.script-coding.com/viewtopic.php?pid=80666#p80666</id>
		</entry>
</feed>
