Search through an email to find and highlight text - vba

I'm working with Excel's VBA trying to automate the sending of some emails. Right now, the code creates an email based on the cells next to the button clicked, forwards the email to the listed in a cell, and then inserts a specific body message based on some more cells. What is in the cells isn't really important, but what I need to do is search the original forwarded message for specific text, and if found, it needs to highlight that text.
My code is as follows:
Sub Asset_email()
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Outlook.MailItem
Dim i As Integer
Dim olMsg As Outlook.MailItem
Dim r As Range
Dim strLocation As String
Dim o As Outlook.Application
Dim strbody As String
'Dim olAtt As Outlook.Attachments
'Set olAtt = olMsg.Attachments
Set r = ActiveSheet.Buttons(Application.Caller).TopLeftCell
Range(Cells(r.Row, r.Column), Cells(r.Row, r.Column)).Select
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("Asset Notifications Macro")
i = 1
For Each olMail In Fldr.Items
If InStr(olMail.body, ActiveCell.Offset(rowOffset:=0, ColumnOffset:=-3).Value) <> 0 Then
olMail.display
strbody = "<BODY style=font-size:11pt;font-family:Calibri>Team,<br><br>" & _
"Please see the notice below regarding " & _
ActiveCell.Offset(rowOffset:=0, ColumnOffset:=-2).Value & _
".<br><br> Feel free to email the CSG team at myemailhere#email.com with any questions.<br><br>" & _
"Thank you!"
With olMail.Forward
.To = ActiveCell.Offset(ColumnOffset:=-1)
.display
SendKeys ("%")
SendKeys ("7")
'Call Sleep
Application.Wait (Now + TimeValue("0:00:03"))
.HTMLBody = strbody & "<br>" & .HTMLBody
End With
End If
Next
End Sub
The code works 100%. I just don't know the correct syntax to search and highlight the results.
In the above example, lets say I wanted to find and highlight the words "Thank you". How would one go about this?

You basically have to use the Word Object Model for the text searching and highlighting. There's a perfect example of how to do it in this article: https://msdn.microsoft.com/en-us/library/gg193974.aspx

Highlight in the active Inspector? Try the following.
You can substitute the line set objInspector = Application.ActiveInspector with set objInspector = olMail.GetInspector
wdColorYellow = 65535
set objInspector = Application.ActiveInspector
set objDoc = objInspector.WordEditor
set objFind = objDoc.Content.Find
objFind.HitHighlight "text_to_highlight", wdColorYellow, , false, true

The Outlook object model provides three main ways for working item bodies:
Body - a string representing the clear-text body of the Outlook item.
HTMLBody - a string representing the HTML body of the specified item. In that case you need to parse the HTML markup and add surrounding tags for highlighting the text. For example, you may use the <b> for bold symbols.
Word editor - the Microsoft Word Document Object Model of the message being displayed. The WordEditor property of the Inspector class returns an instance of the Document class from the Word object model which you can use to work on the message body. The Bold property of the Font class allows to format the text as bold.
You can read more about all these ways in the Chapter 17: Working with Item Bodies. It us up to you which way (HTML or Word object model) is to choose for highlighting the text.

Figured it out:
.HTMLBody = Replace(.HTMLBody, "Thank you", "<FONT style=" & Chr(34) & "BACKGROUND-COLOR: yellow" & Chr(34) & ">" & "Thank you" & "</FONT>")

Related

Paste Text in specified position

I have code from searches modified for my need.
I need to position the paste under the "Conditions" text in the xOutMsg variable. It is pasting into the first line in the email.
How do I paste on the next line after the word "Conditions"?
Sub PrepareConditionsEmail()
Dim objDoc As Word.Document
Dim objSel As Word.Selection
Dim xOutApp As Object
Dim xOutMail As Object
Dim xOutMsg As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xOutMsg = "<br /><br /><b><u>Conditions:</b></u><br /><br />" & "<b><u> </b></u><br />"
With xOutMail
'.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "Conditions"
.HTMLBody = xOutMsg
.Display
End With
Set xOutMail = Nothing
Set xOutApp = Nothing
On Error Resume Next
Set objDoc = Application.ActiveInspector.WordEditor
Set objSel = objDoc.Windows(1).Selection
objSel.PasteSpecial Link:=False, _
DataType:=wdPasteText, _
Placement:=wdInLine, _
DisplayAsIcon:=False
End Sub
It seems you need to parse the message and insert your own text or markup there. The MailItem.HTMLBody property sets a string representing the HTML body of the specified item. Use the InStr function which returns a long specifying the position of the first occurrence of one string within another. After you get the keyword position you may insert your substring right after the keyword.
InStr(mail.HTMLBody, "keyword", 1)
Read more about the InStr function in MSDN.
The Outlook object model supports three main ways of customizing the message body:
The Body property returns or sets a string representing the clear-text body of the Outlook item.
The HTMLBody property of the MailItem class returns or sets a string representing the HTML body of the specified item. Setting the HTMLBody property will always update the Body property immediately. For example:
Sub CreateHTMLMail()
'Creates a new e-mail item and modifies its properties.
Dim objMail As Outlook.MailItem
'Create e-mail item
Set objMail = Application.CreateItem(olMailItem)
With objMail
'Set body format to HTML
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><BODY>Enter the message text here. </BODY></HTML>"
.Display
End With
End Sub
The Word object model can be used for dealing with message bodies. See Chapter 17: Working with Item Bodies for more information.
There is no need to mix HTMLBody and WordEditor approaches together. You can choose a single way and use it.

Generated reply email is catching the oldest email that includes the subject text

The code below will generate a reply email based on the text that is input in the cell Worksheets("Checklist Form").Range("B5"))
This reply email has all the recipients, a customized body, subject and everything works perfectly. EXCEPT I realized through testing that it will grab the oldest email with the text subject or the oldest email that contains that text in it's subject. The thing is, the code seems to copy the recipients from the oldest email of the oldest thread that is in your inbox but then replies to the most recent email in that same thread.
For example if the worksheet(Checklist Form B5) contains the phrase "Kawhi Leonard" the reply email generated will reply to the oldest email thread, but the newest email it seems in that thread. What's weird is it will catch the recipients of the oldest email of the oldest thread in your inbox that contains that subject.
This is a problem since I get many emails with some of the same key words or subjects. Is there a solution to have the code grab the most recent text in a subject of an email. Or a better solution would have a choice of catching the most recent or another one. Or also grab the email with the exact subject not the oldest one that contains the text in it's subject.
Sub Display()
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim i As Integer
Dim IsExecuted As Boolean
Signature = Environ("appdata") & "\Microsoft\Signatures\"
If Dir(Signature, vbDirectory) <> vbNullString Then
Signature = Signature & Dir$(Signature & "*.htm")
Else
Signature = ""
End If
Signature = CreateObject("Scripting.FileSystemObject").GetFile(Signature).OpenAsTextStream(1, -2).ReadAll
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
IsExecuted = False
For Each olMail In Fldr.Items
If InStr(olMail.Subject, Worksheets("Checklist Form").Range("B5")) <> 0 Then
If Not IsExecuted Then
With olMail.ReplyAll
.HTMLBody = "<p style='font-family:calibri;font-size:14.5'>" & _
"Hi Everyone," & "<p style='font-family:calibri;font-size:14.5'>" & _
Worksheets("Checklist Form").Range("B4") & "Regards," & "</p><br>" & _
Signature & .HTMLBody
.Display
End With
IsExecuted = True
End If
End If
Next olMail
End Sub
Firstly, never loop through all items in a folder - use Items.Find/FindNext or Items.Restrict. In your particular case, call Items.Sort, then Items.Find - you only need a ingle item.
Secondly, you need to sort the collection first - call Items.Sort on ReceivedTime.
Thirdly, you are invoking Worksheets("Checklist Form").Range("B5") on each step of the loop. This is extremely inefficient.
Off the top of my head:
set items = Fldr.Items
items.Sort "ReceivedTime", true
strSubject = Worksheets("Checklist Form").Range("B5")
set olMail = items.Find(" #SQL=Subject LIKE '" & strSubject & "'")

Insert filepath as hyperlink Excel VBA

I have a VBA set of code that generates an email and automatically sends it.
One of the things that I cannot get to work properly is putting a hyperlink to a specified folder location within the email.
Dim fpath As String
fpath = Worksheets("MS_JRNL_OPEN_TU_FR-4333635").Range("AD5").Value
"file://" & fpath & _
Essentially the user has to input a folder location when running the Macro which is in Cell AD5, but I want this is appear as the full folder location as a hyperlink once the email is generated.
Any help would be greatly appreciated
If you are currently using HTMLBody in your email code, it's quite easy to do. I'll assume you are using code similar to below. Take note of strbody and .HTMLBody. Assuming your fpath is formatted like C:\Users\tjb1\Desktop\file.docx then you don't need to add anything else to it. The section creating the hyperlink is "test link". You can change test link to say whatever you want or change the line to "" & fpath & "" to use the path as the link text.
Sub MailURL()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "test link"
On Error Resume Next
With OutMail
.To = "APerson#Somewhere.com"
.Subject = "Testing URL"
.HTMLBody = strbody
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I found the code above at MrExcel and just formatted it a bit to work with your variable.

How to send a Word document as body of an email with VBA

I've created a macro that works with outlook and excel that will use a list of email addresses (in excel) and send all those addresses an email (in outlook). I want to take a word document (from microsoft word) and use it as the body of the email. The problem is, I will have images in the word document and I need the word document to keep it's formatting. Right now, my VBA takes the content of my word document but the formatting is gone and images aren't included. This is my code:
Sub spamEmail()
'Setting up the Excel variables.
Dim olApp As Object
Dim oMail As Outlook.MailItem
Dim iCounter As Integer
Dim Dest As Variant
Dim SDest As String
Dim Excel As Object
Dim Name As String
Dim Word As Object
Dim oAccount As Outlook.Account
Dim doc As Word.Document
Dim itm As Object
Dim MsgTxt As String
'Set the outlook account to send.
Set oAccount = Application.Session.Accounts.Item(2)
'Create excel object.
Set Excel = CreateObject("excel.application")
Excel.Visible = True
Excel.Workbooks.Open ("C:\Users\Deryl Lam\Documents\Book1.xlsx")
Excel.Workbooks("Book1.xlsx").Activate
'Create a word object.
Set Word = CreateObject("word.application")
Set doc = Word.Documents.Open _
(FileName:="C:\Users\Deryl Lam\Documents\emailBody.docx", ReadOnly:=True)
'Pulls text from file for message body
MsgTxt = doc.Range(Start:=doc.Paragraphs(1).Range.Start, _
End:=doc.Paragraphs(doc.Paragraphs.Count).Range.End)
'Loop through the excel worksheet.
For iCounter = 1 To WorksheetFunction.CountA(Workbooks("Book1.xlsx").Sheets(1).Columns(1))
'Create an email for each entry in the worksheet.
Set oMail = Application.CreateItem(olMailItem)
With oMail
SDest = Cells(iCounter, 1).Value
If SDest = "" Then
'Dont do anything if the entry is blank.
Else
'Do additional formatting on the BCC and Subject lines, add the body text from the spreadsheet, and send.
Name = Cells(iCounter, 2).Value
.BCC = SDest
.Subject = "FYI"
.Body = "Dear " & Name & "," & vbCrLf & MsgTxt
'SendUsingAccount is new in Office 2007
'Change Item(1)to the account number that you want to use
.SendUsingAccount = oAccount
.Send
End If
End With
Next iCounter
'Clean up the Outlook application.
Set olMailItm = Nothing
Set olApp = Nothing
End Sub
I've searched all over google for a solution but I haven't found one. How can I send a word document as the body of the email with it's formatting in tact and the images included?
You are getting the contents of your template document as a string, which by definition will not contain any formatting or images. You should instead copy the contents to the clipboard and then paste them into the new email.
Something like this:
Sub emailFromDoc()
Dim wd As Object, editor As Object
Dim doc As Object
Dim oMail As MailItem
Set wd = CreateObject("Word.Application")
Set doc = wd.documents.Open(...path to your doc...)
doc.Content.Copy
doc.Close
set wd = Nothing
Set oMail = Application.CreateItem(olMailItem)
With oMail
.BodyFormat = olFormatRichText
Set editor = .GetInspector.WordEditor
editor.Content.Paste
.Display
End With
End Sub
If not for the images, you could save the document as an HTML file, read its contents, then set the MailItem.HTMLBody property.
Images are more involved. I don't see a straightforward way to bring them into a message body.

VBA retrieve HTMLBody from Outlook mail

First I create an email via Outlook:
Sub CreateHTMLMail()
'Creates a new e-mail item and modifies its properties.
Dim olApp As Outlook.Application
Dim objMail As Outlook.MailItem
Set olApp = Outlook.Application
'Create e-mail item
Set objMail = olApp.CreateItem(olMailItem)
Dim sHTML_Open As String
Dim sHTML_Introduction As String
Dim sHTML_Goodbye As String
Dim sHTML_Close As String
Dim sHTML_Process_Date As String
Dim sHTML_Processor As String
Dim sHTML_Issuer As String
Dim sHTML_Details As String
Dim sHTML_Body As String
sHTML_Open = "<HTML><BODY>"
sHTML_Introduction = "Hi team,<BR/><BR/>" & _
"Data is ready to process. Please find details as below.<BR/>"
sHTML_Process_Date = "<P ID='PROCESSDATE'>28 February 2013</P>"
sHTML_Processor = "<P ID='PROCESSOR'>AKSHAY</ID></P>"
sHTML_Issuer = "<P ID='ISSUER'>DATAGROUP.COM</ID></P>"
sHTML_Details = "<P ID='DETAILS'>" & _
"<UL>" & _
"<LI>Fimta23456 09:00:00 flor345</LI>" & _
"<LI>Fimta23456 09:00:00 flor345</LI>" & _
"</UL>" & _
"</P><BR/>"
sHTML_Goodbye = "Thanks"
sHTML_Close = "</BODY></HTML>"
sHTML_Body = sHTML_Open & sHTML_Introduction & sHTML_Process_Date & sHTML_Processor & sHTML_Issuer & _
sHTML_Details & sHTML_Goodbye & sHTML_Close
With objMail
'Set body format to HTML
.BodyFormat = olFormatHTML
.To = "Kim Gysen"
.Subject = "data remit file"
.HTMLBody = sHTML_Body
.Display
End With
End Sub
Via code, I want to retrieve values based on ID.
This seemed the cleanest way for me, I don't particulary like the "split" method because it's kind of hard coding; not very dynamic and kinda unreliable.
Unfortunately when I retrieve the HTML body, I cannot retrieve the original HTML, as it is distorted by Outlook:
Sub Get_OL()
Dim oFolder As MAPIFolder
Dim oItem As Variant
Dim sHTML_Body As String
Dim sHTML_Process_Date As String
Dim sHTML_Processor As String
Dim sHTML_Issuer As String
Dim sHTML_Details As String
Dim oExcel As Object
Dim oBook As Workbook
Set oExcel = CreateObject("Excel.Application")
Set oBook = oExcel.Workbooks.Add
'Access the outlook inbox folder
Set oFolder = GetNamespace("MAPI").PickFolder
'On error resume next usually not to use, but feteching emails may give unexpected errors
On Error Resume Next
For Each oItem In oFolder.Items
If TypeOf oItem Is Outlook.MailItem Then
If oItem.Subject Like "*data remit file*" Then
'Turn off on error resume next asap
On Error GoTo 0
sHTML_Body = oItem.HTMLBody
Debug.Print sHTML_Body
Exit For
End If
End If
Next oItem
End Sub
On debug.print, this is what I get (only putting the last line of the Format):
</o:shapelayout></xml><![endif]--></head><body lang=EN-GB link=blue vlink=purple><div class=WordSection1><p class=MsoNormal>Hi team,<br><br>Data is ready to process. Please find details as below.<br><br><o:p></o:p></p><p>28 February 2013<o:p></o:p></p><p id=PROCESSOR>AKSHAY<o:p></o:p></p><p id=ISSUER>DATAGROUP.COM<o:p></o:p></p><ul type=disc><li class=MsoNormal style='mso-margin-top-alt:auto;mso-margin-bottom-alt:auto;mso-list:l0 level1 lfo1'>Fimta23456 09:00:00 flor345<o:p></o:p></li><li class=MsoNormal style='mso-margin-top-alt:auto;mso-margin-bottom-alt:auto;mso-list:l0 level1 lfo1'>Fimta23456 09:00:00 flor345<o:p></o:p></li></ul><p class=MsoNormal><br>Thanks<o:p></o:p></p></div></body></html>
I would like to retrieve the original HTML that I put in the HTMLBody.
2 ways:
1) parsing text - several things to do (not recommended: hard-coding)
All what you need is to parse text, but MSDN shows how to do it using InStr function. I would strongly suggest to use RegEx to parse html text. Note: reference to MS VBScript Regular Expressions x.x is needed.
Simple Regular Expression Tutorial for Excel VBA
2) using UserProperites of MailItem object (recommended)
If MailItem doesn't contains your propert(y)ies, than there is nothing to do ;)
How to: Add custom property