Hi all,
I am trying to find position of certain words in email body (Hi, Hello, Good morning, Kind regards). For 70% of received emails it works fine, but for some emails it does not recognize these words. If I manually forward email to me and then do a search, it finds them, but if I forward it to me via Macro, problem remains.
Can someone help me with this?
Bellow is my code.
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 = "testemail@email.com"
msg.Recipients.ResolveAll
'msg.Send
msg.Display
Exit Sub
End If
If pos1 = 0 And pos2 = 0 And pos3 = 0 Then
msg.To = "testemail@email.com"
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
I am trying to find position of certain words in email body (Hi, Hello, Good morning, Kind regards). For 70% of received emails it works fine, but for some emails it does not recognize these words. If I manually forward email to me and then do a search, it finds them, but if I forward it to me via Macro, problem remains.
Can someone help me with this?
Bellow is my code.
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 = "testemail@email.com"
msg.Recipients.ResolveAll
'msg.Send
msg.Display
Exit Sub
End If
If pos1 = 0 And pos2 = 0 And pos3 = 0 Then
msg.To = "testemail@email.com"
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