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
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:
See Chapter 17: Working with Item Bodies for more information.