Thanks Thanks:  0
Likes Likes:  0
Results 1 to 5 of 5

Thread: Open .msg file and add emails

  1. #1
    New Member
    Join Date
    Jan 2019
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Open .msg file and add emails

    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

  2. #2
    Board Regular
    Join Date
    Oct 2007
    Posts
    5,630
    Post Thanks / Like
    Mentioned
    6 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Open .msg file and add emails

    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

  3. #3
    New Member
    Join Date
    Jan 2019
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Open .msg file and add emails

    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?

  4. #4
    Board Regular
    Join Date
    Oct 2007
    Posts
    5,630
    Post Thanks / Like
    Mentioned
    6 Post(s)
    Tagged
    2 Thread(s)

    Default Re: Open .msg file and add emails

    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

  5. #5
    New Member
    Join Date
    Jan 2019
    Posts
    9
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Open .msg file and add emails

    Perfect!

    Thank You John_W!!!

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •