-1

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,

Eugene Astafiev
  • 47,483
  • 3
  • 24
  • 45
mikizas
  • 331
  • 5
  • 16

3 Answers3

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.

Eugene Astafiev
  • 47,483
  • 3
  • 24
  • 45
1

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.

Dmitry Streblechenko
  • 62,942
  • 4
  • 53
  • 78
0

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
mikizas
  • 331
  • 5
  • 16