Edit Outlook locally saved .msg body by replacing text in VBA - excel

Question

Good afternoon,
I have an Outlook .msg email saved at a local folder in my computer.
Is there any way I can replace the word "AAAA" in the body with any word I want in VBA?
Is there any way I can change the To: field?
The goal is to run an Excel table and create copies of a template message, replace the To: field and some words of the template with the info in the Excel table and save it. We will manually send latter.
I only need the .msg file modifying code (To: field and body replaces). The loop is already coded.
Thank you so much,

Answer 1

The Outlook object model doesn't provide anything to edit MSG files out of the box. But you can automate Outlook to create an item, edit it and then save it back as a template.
Use the Application.CreateItemFromTemplate method which creates a new Microsoft Outlook item from an Outlook template (.oft) and returns the new item. So, you can create a new item based on the template saved on the disk and then replace everything you need there. Then you could save it back as a template or send the item out. Read more about that in the How To: Create a new Outlook message based on a template article.

Answer 2

You can use Application.Session.OpenSharedItem to open an MSG file, modify the returned MailItem object (Subject / HTMLBody / Recipients), then call MAilItem.Save to update the MSG file.

Answer 3

If anyone needs, here it is the code I used. Do not focus on the for loops, but in the way the msg is loaded, edited and saved.
In this example some words in the msg file are replaced for the values in an excel table, as well as the TO: (email receiver). e.g. word AA in a msg file is changed with the value of the C7 cell.
The aim is to create a msg as a template with some key words (AA, BB, CC, etc), copy that template, replace those words with the ones in the excel table and save the new msg file.
Sub Recorrer()
Dim x As Integer
Dim fsObject As Object
Dim outApp As Object 'Outlook.Application
Dim outEmail As Object 'Outlook.MailItem
Dim outRecipient As Object 'Outlook.Recipient
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
If outApp Is Nothing Then
MsgBox "Outlook is not open"
Exit Sub
End If
On Error GoTo 0
Set fsObject = CreateObject("Scripting.FileSystemObject")
' Set numcols = number of cols to be replaced.
NumCols = Range("C1", Range("C1").End(xlToRight)).Cells.Count
' Set numrows = number of rows of data.
NumRows = Range("A2", Range("A2").End(xlDown)).Rows.Count
' Select cell a1.
Range("A2").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows
fsObject.CopyFile ThisWorkbook.Path & "\" & Range("B" & x + 1) & ".msg", ThisWorkbook.Path & "\Correos\" & Range("B" & x + 1) & "_" & Range("C" & x + 1) & ".msg"
Set outEmail = outApp.Session.OpenSharedItem(ThisWorkbook.Path & "\Correos\" & Range("B" & x + 1) & "_" & Range("C" & x + 1) & ".msg")
outEmail.Recipients.Add Range("A" & x + 1)
For Z = 1 To NumCols
'MsgBox Cells(x + 1, Z + 2)
outEmail.HTMLBody = Replace(outEmail.HTMLBody, Cells(1, Z + 2), Cells(x + 1, Z + 2))
Next
outEmail.Save
' Selects cell down 1 row from active cell.
ActiveCell.Offset(1, 0).Select
Next
End Sub