访问VBA以查找最后一封电子邮件并将文本添加到电子邮件线程

时间:2019-07-10 11:33:20

标签: vba access-vba ms-access-2016

我正在尝试编写一些VBA,以便在Outlook中搜索我的“已发送邮件”并打开最后一封电子邮件到指定电子邮件地址(此部分已完成,请检查!)- AND 电子邮件链,同时保持先前的消息完好。

我有下面的代码,但是它创建了一个“空白面板”,因此所有以前的电子邮件通信都丢失了。我需要做些什么,以便当我在电子邮件的正文中添加文本时,所有以前的信件仍然保留?

FunctionComposeResponse(searchEmail As String, emailBody As String)
Dim currDateTime As Date: currDateTime = Now()
Dim tenDayPrior As Date: tenDayPrior = DateValue(CStr(Now())) - 10 & " 07:00:00 AM"
Dim olApp As Outlook.Application
Dim olNS As NameSpace
Dim Fldr As Folder
Dim olReply As Outlook.MailItem
Dim msg As Object
Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set Fldr = olNS.GetDefaultFolder(olFolderSentMail)
For Each msg In Fldr.Items
  If TypeName(msg) = "MailItem" Then
    For Each recipient in msg.recipients
       If recip.Address = searchEmail Then
         If msg.SentOn >= tenDayPrior And msg.SentOn <= currDateTime Then
           Set olReply = msg.ReplyAll
           With olReply
              .BodyFormat = olFormatHTML
              .HTMLBody = emailBody
              .Save
              .Close olSave
           End With
         End If
       End If
    Next recip
  End If
Next msg
End Function

1 个答案:

答案 0 :(得分:1)

通过设置

.HTMLBody = emailBody

您覆盖了以前的所有内容。

您需要将文本插入到现有的.HTMLBody中。

对于新邮件项目,我要保留默认的HTML签名,我使用以下方法-检查您现有的.HTMLBody,以了解这是否也适用于Reply(如果不适用)。

' emailBody is plain text -> encode as HTML
emailBody = HtmlEncode(emailBody)

' Outlook-HTML: mail text begins with this line:
'  <p class=MsoNormal><o:p>&nbsp;</o:p></p>
' Insert my text instead of the first &nbsp;
oItem.HtmlBody = Replace(oItem.HtmlBody, "&nbsp;", emailBody, Count:=1)