Replace a string in a sent email

问题

The following code creates and sends a simple email. After the email is sent it replaces a string in the email body.

My code works when I use the debugger’s single-step feature to execute the code. It also works when I add a MsgBox instruction with a “click to continue” button after the objMsg.Send instruction. It does not work when I execute the macro without interruption, but tells me that Outlook cannot save an email to the folder when a macro is running.

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

回答1:

The delaying actions you take are enough for the send to complete. Without the delay the message is not yet in the Sent items folder.

You could instead use ItemAdd with appropriate conditions in the code so it processes applicable messages.

This will process the item most recently added to the Sent Items folder.

Code for ThisOutlookSession

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

Source in case this untested code has typos. How do I trigger a macro to run after a new mail is received in Outlook?

回答2:

Following the comments that I received I am posting the final code that I tested and works. It replaces a string in the last sent message (after being sent and saved).

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

来源：https://stackoverflow.com/questions/34190000/replace-a-string-in-a-sent-email