Activating specific email in Outlook with VBA & deleting signature from the copied text

Question

I'm looking to use the get function in vba in order to activate a specific email in Outlook and then copy the body into a new email and send. I can use the getlast function to get the latest email in the inbox, however I would like to refine the code some more by selecting the latest email from a specific email address.

Also, I'd love how to know how to delete the signature from the text pasted into the new email.

Sub Negotiations()

Dim objMsg As Outlook.MailItem
Dim objItem As Outlook.MailItem
Dim BodyText As Object
Dim myinspector As Outlook.Inspector
Dim myItem As Outlook.MailItem
Dim NewMail As MailItem, oInspector As Inspector

Set myItem = Application.Session.GetDefaultFolder(olFolderInbox).Items.GetLast
myItem.Display

'copy body of current item

Set activeMailMessage = ActiveInspector.CurrentItem
activeMailMessage.GetInspector().WordEditor.Range.FormattedText.Copy

' Create the message.
Set objMsg = Application.CreateItem(olMailItem)

'paste body into new email
Set BodyText = objMsg.GetInspector.WordEditor.Range
BodyText.Paste

'set up and send notification email
With objMsg
    .To = "@gmail.com"
    .Subject = "Negotiations"
    .HTMLBody = activeMailMessage.HTMLBody
    .Display

End With
End Sub

any help would be appreciated, thank you guys!

Answer 1

Open the Inbox folder using Namespace.GetDefaultFolder(olFolderInbox), retrieve the Items collection from MAPIFolder.Items. Sort the items (Items.Sort) on the ReceivedTime property, retrieve the latest email using Items.Find on the SenderEmailAddress property.

Answer 2

Dependant on what your property of .SenderEmailAddress returns, you can adapt what the while statement evaluates for. This should work for you, by first looking at the last e-mail, and then checking each previous e-mail for the correct sender address.

Sub display_mail()
    Dim outApp As Object, objOutlook As Object, objFolder As Object
    Dim myItems As Object, myItem As Object
    Dim strSenderName As String

    Set outApp = CreateObject("Outlook.Application")
    Set objOutlook = outApp.GetNamespace("MAPI")
    Set objFolder = objOutlook.GetDefaultFolder(olFolderInbox)
    Set myItems = objFolder.Items
    strSenderName = UCase(InputBox("Enter the e-mail Alias."))

    Set myItem = myItems.GetLast
    While Right(myItem.SenderEmailAddress, Len(strSenderName)) <> strSenderName
        Set myItem = myItems.GetPrevious
    Wend
    myItem.Display
End Sub

Answer 3

Application.Session.GetDefaultFolder(olFolderInbox).Items.GetLast activeMailMessage.GetInspector().WordEditor.Range.FormattedText.Copy

First of all, I'd recommend breaking the chain of calls. Declare each property or method call on a separate line of code, so you will be able to debug the code at any time and see what happens under the hood.

The GetLast method returns the last object in the collectio. But it doesn't mean that the item is recieved last. You need to sort the collection using the Sort method as Dmitry suggested passing the ReceivedTime property as a parameter to sort on. Only in that case you will get the last recieved item from the collection.

The Outlook object model doesn't provide any special method or property for identifying signatures. You need to parse the message body and find it programmatically.

Answer 4

Sub Nego()

Dim objMsg As Outlook.MailItem
Dim myItem As Outlook.MailItem
Dim BodyText As Object
Dim Inspector As Outlook.MailItem
Dim olNameSpace As Outlook.NameSpace
Dim olfolder As Outlook.MAPIFolder

Dim msgStr As String
Dim endStr As String
Dim endStrStart As Long
Dim endStrLen As Long
Dim myItems As Outlook.Items



    'Access folder Nego
Const olFolderInbox = 6
    Set objOutlook = CreateObject("Outlook.Application")
    Set objNamespace = objOutlook.GetNamespace("MAPI")
    Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox)
    strFolderName = objInbox.Parent
    Set objMailbox = objNamespace.Folders(strFolderName)
    Set objFolder = objMailbox.Folders("Nego")

    'Mark as read
For Each objMessage In objFolder.Items
    objMessage.UnRead = False
    Next

    'Sort
Set myItems = objFolder.Items
    For Each myItem In myItems
    myItems.Sort "Received", False
    Next myItem
    myItems.GetLast.Display

    'copy body of current item
Set activeMailMessage = ActiveInspector.CurrentItem
    activeMailMessage.GetInspector().WordEditor.Range.FormattedText.Copy

    ' Create the message.
Set objMsg = Application.CreateItem(olMailItem)

    'paste body into new email
Set BodyText = objMsg.GetInspector.WordEditor.Range
    BodyText.Paste

    'Search Body
Set activeMailMessage = ActiveInspector.CurrentItem
    endStr = "first line of signature"
    endStrLen = Len(endStr)
    msgStr = activeMailMessage.HTMLBody
    endStrStart = InStr(msgStr, endStr)
    activeMailMessage.HTMLBody = Left(msgStr, endStrStart + endStrLen)

    'set up and send email
With objMsg
    .To = "@email"
    .Subject = "Nego"
    .HTMLBody = activeMailMessage.HTMLBody
    .HTMLBody = Replace(.HTMLBody, "First line of signature", " ")
    .Send

End With


End Sub