Open .msg file and add emails

kabootar

New Member
Joined
Jan 15, 2019
Messages
10
Hi,

I have a macro for opening a .msg file but I need to also add email addresses. The email addresses will be different depending on the project.

Is this possible?

The macro I currently have is:

Sub OpenOutlookMsg ()

Dim myoutapp As Object
Dim myitem A Object

Set myoutapp = CreateObject("Outlook.Application")
Set myitem = myoutapp.CreateItemFromTemplate("C:\Users\aa\Desktop\Project.msg")

myitem.Display

End sub
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Try this to get started:
Code:
Public Sub Add_Email_Addresses_To_Outlook_Msg()

    Dim outApp As Object 'Outlook.Application
    Dim outEmail As Object 'Outlook.MailItem
    Dim outRecipient As Object 'Outlook.Recipient
    Dim newEmailAddresses As String, newEmailAddress As Variant
    
    newEmailAddresses = "email1@address.com,email2@address.com"
       
    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

    'Open .msg file in Outlook 2003
    'Set outEmail = outApp.CreateItemFromTemplate("C:\Users\aa\Desktop\Project.msg")
    
    'Open .msg file in Outlook 2007+
    Set outEmail = outApp.Session.OpenSharedItem("C:\Users\aa\Desktop\Project.msg")
    
    For Each newEmailAddress In Split(newEmailAddresses, ",")
        outEmail.recipients.Add newEmailAddress
    Next

    outEmail.Save           'Save with existing file name
    'outEmail.SaveAs "C:\Users\aa\Desktop\NEW Project.msg"     'Or save with new folder and/or file name
    
End Sub
 
Upvote 0
That is perfect!

Just one thing - when I edit the email addresses it still gives me the above emails you entered.

How can I remove this?
 
Upvote 0
Either manually recreate/save the original .msg file, or run this macro which removes the specified email addresses:

Code:
Public Sub Remove_Email_Addresses_From_Outlook_Msg()

    Dim outApp As Object 'Outlook.Application
    Dim outEmail As Object 'Outlook.MailItem
    Dim outRecipient As Object 'Outlook.Recipient
    Dim removeEmailAddresses As String, removeEmailAddress As Variant
    Dim i As Long
    
    removeEmailAddresses = "email1@address.com,email2@address.com"
       
    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

    'Open .msg file in Outlook 2003
    'Set outEmail = outApp.CreateItemFromTemplate("C:\Users\aa\Desktop\Project.msg")
    
    'Open .msg file in Outlook 2007+
    Set outEmail = outApp.Session.OpenSharedItem("C:\Users\aa\Desktop\Project.msg")
        
    For Each removeEmailAddress In Split(removeEmailAddresses, ",")
        For i = outEmail.recipients.Count To 1 Step -1
            If InStr(1, outEmail.recipients(i), removeEmailAddress, vbTextCompare) Then
                outEmail.recipients.Remove i
            End If
        Next
    Next
    
    outEmail.Save           'Save with existing file name
    'outEmail.SaveAs "C:\Users\aa\Desktop\NEW Project.msg"     'Save with new file name
    
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,208
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top