Vba 替换已发送电子邮件中的字符串

下面的代码创建并发送一封简单的电子邮件。发送电子邮件后，它将替换电子邮件正文中的字符串

当我使用调试器的单步功能来执行代码时，我的代码可以工作。当我在

objMsg.Send

指令后添加带有“单击继续”按钮的MsgBox指令时，它也会起作用。当我不间断地执行宏时，它不起作用，但它告诉我，当宏运行时，Outlook无法将电子邮件保存到文件夹中

Sub CreateNewMessage()

     objMsg As MailItem

    Set objMsg = Application.CreateItem(olMailItem)

     With objMsg
      .To = "mblasberg@inoxel.com"
      .subject = "This is the subject"
      .BodyFormat = olFormatHTML
      .Body = "How are you doing?"
    End With
    objMsg.Send

  ' The following code replaces in the email body the string "you" with "they"

  ' Because I could not find how to open the "last sent" email,
  ' I used the "Sent Items" folder email count as as the pointer
  ' to the last email.

    Dim myNameSpace As Outlook.NameSpace
    Dim myFolder As Outlook.Folder
    Dim myItem As Object

    Set myNameSpace = Application.GetNamespace("MAPI")
    Set myFolder = _
        myNameSpace.GetDefaultFolder(olFolderSentMail)

    Dim EmailCount As Integer

    EmailCount = myFolder.Items.Count
    Set myItem = myFolder.Items(EmailCount)
    myItem.HTMLBody = replace(myItem.HTMLBody, "you", "they")
    myItem.Save

End Sub

---

您采取的延迟操作足以完成发送。没有延迟，邮件还没有在“已发送邮件”文件夹中

您可以在代码中使用带有适当条件的ItemAdd，以便它处理适用的消息

这将处理最近添加到“已发送邮件”文件夹的项目

此Outlook会话的代码

Option Explicit

Private WithEvents sItems As Items 

Private Sub Application_Startup() 
    Dim objNS As NameSpace 
    Set objNS = GetNamespace("MAPI") 
    ' default local Sent Items folder
    Set sItems = objNS.GetDefaultFolder(olFolderSentMail).Items 
End Sub

Private Sub sItems_ItemAdd(ByVal item As Object) 

    If TypeName(item) = "MailItem" Then          
          ' ******************
          ' do something here with item
          ' ******************
           Debug.Print item.subject
    End If

End Sub

---

源代码，以防此未经测试的代码输入错误

在收到评论之后，我发布了我测试并运行的最终代码。它将替换上次发送的消息中的字符串（在发送和保存后）

---

您也不应该假设MAPIFolder.Items.Item（Items.Count）将为您提供最后一封邮件。除非对项目集合进行显式排序，否则无法确定顺序。谢谢Dmitry。当我增加延迟时，它没有帮助。在我的应用程序中，我不能添加MSgBOX或其他手动延迟。它必须自动工作。你能给我解释一下，或者给我建议代码，我怎样才能检测到邮件被保存在“已发送邮件”文件夹中。目前还不清楚ItemAdd将如何完成这项工作。在我看来，除非宏未完成或停止，否则系统将永远不会将发送的消息保存在sent Items文件夹中。再次感谢您的帮助。请注意，我需要搜索并重播我发送的每封邮件上的ea字符串。尼顿，我上一封邮件的原意是给您的。关于Dmitry的评论：我注意到并测试了MAPIFolder.Items.Item（Items.Count）始终基于保存日期。最早的一个索引是1。最大索引始终是最后一个索引。在我的安装中，该索引与您的索引相反。

Sub Replace_LSM_String()

Set Folder = Application.Session.GetDefaultFolder(olFolderSentMail)
Set Items = Folder.Items
Items.sort "[ReceivedTime]", False
Set oldestMessage = Items.GetLast
oldestMessage.HTMLBody = Replace(Items.GetLast.HTMLBody, "old string",_ 
"new   string")
Items.GetLast.Save

End Sub