Search code examples
vbaemailoutlookoutlook-mac

How to find positions of words in email and get part of email?


I am trying to find the position of certain words (Hi, Hello, Good morning, Kind regards) in the email body and get part of the email body.

For 30% of received emails it does not recognize these words.

If I manually forward email to myself and then do a search, it finds them.
If I forward it to myself via macro, problem remains.

Sub Display()
    Dim oApp As Outlook.Application
    Dim objFolder As Outlook.MAPIFolder
    Set oApp = New Outlook.Application
    Set objNS = Application.GetNamespace("MAPI")
    Set objFolder = objNS.GetDefaultFolder(olFolderInbox)

    Dim pos1 As Long
    Dim pos2 As Long
    Dim pos3 As Long
    Dim pos4 As Long
    Dim pos5 As Long

    Dim msg As Outlook.MailItem

    For Each objItem In Application.ActiveExplorer.Selection

        Set msg = objItem.Forward

        msg.HTMLBody = objItem.HTMLBody
        msg.Subject = ("Test")

        pos1 = InStr(msg.HTMLBody, "Hi,")
            MsgBox ("pos1 " & pos1)
        pos2 = InStr(msg.HTMLBody, "Hello")
            MsgBox ("pos2 " & pos2)
        pos3 = InStr(msg.HTMLBody, "Good morning")
            MsgBox ("pos3 " & pos3)
        pos4 = InStr(msg.HTMLBody, "Kind regards")
            MsgBox ("pos4 " & pos4)

        If pos5 = 0 Then
            msg.To = "[email protected]"
            msg.Recipients.ResolveAll
            'msg.Send
            msg.Display
            Exit Sub
        End If

        If pos1 = 0 And pos2 = 0 And pos3 = 0 Then
            msg.To = "[email protected]"
            msg.Recipients.ResolveAll
            'msg.Send
            msg.Display
            Exit Sub
        End If

        If Not pos1 = 0 Then
            If Not pos4 = 0 Then
                msg.HTMLBody = Mid(msg.HTMLBody, pos1, pos4 - pos1 + Len("Kind regards"))
            End If
        ElseIf Not pos2 = 0 Then
            If Not pos4 = 0 Then
                msg.HTMLBody = Mid(msg.HTMLBody, pos2, pos4 - pos2 + Len("Kind regards"))
            End If
        ElseIf Not pos3 = 0 Then
            If Not pos4 = 0 Then
                msg.HTMLBody = Mid(msg.HTMLBody, pos3, pos4 - pos3 + Len("Kind regards"))
            End If
        End If

        msg.Display
    Next
End Sub

Solution

  • There is no need to re-assignt the message body when you forward items in Outlook. When you do this manually the following action is not executed:

    msg.HTMLBody = objItem.HTMLBody
    

    FYI The Outlook object model provides three main ways for working with item bodies:

    1. Body.
    2. HTMLBody.
    3. The Word editor. The WordEditor property of the Inspector class returns an instance of the Word Document which represents the message body.

    See Chapter 17: Working with Item Bodies for more information.