Search code examples
vbaemailoutlookms-word

Detect an open Outlook email and add to .to field


I've written a Word document that contains step-by-step instructions about our duties.

Along with that, I've created CommandButtons that, when clicked, create an email with the .to, .subject and .HTMLBody pre-populated.

By design, it does not send automatically - it will still need editing by the user.

There are circumstances where more recipients need to be added to the .to field.

I'd like another CommandButton in the Word document that will detect the already created (and open, but not necessarily 'on top') email and append the email address to the .to list.

'Global variables so I only have to update emails in one place
Public Group1 As String
Public Group2 As String
Public Group3 as String

'called to assign emails to global variables
Sub Contacts()

    Group1 = "[email protected]; [email protected]; [email protected]; "
    Group2 = "[email protected]; [email protected]; "
    Group3 = "[email protected]; [email protected]; "

End Sub

Private Sub CommandButton100_Click()

    Dim xOutlookObj As Object
    Dim OMail As Object
    Dim xEmail As Object
    Dim xDoc As Object
    Application.ScreenUpdating = False
    
    Set xOutlookObj = CreateObject("Outlook.Application")
    Set xEmail = xOutlookObj.CreateItem(olMailItem)
    Set xDoc = ActiveDocument

    'assign values to global variables
    Call Contacts

    With xEmail
        .Display
        .to = Group1 + Group2
        .Subject = "This is a Test"
        .HTMLBody = "<font face=""arial"" style=""font-size:11pt;"">" & _
            "body" & .HTMLBody & "</font>"
        'Side-note - the end of the above line is the only way I could figure out how to keep the Signature stored in Outlook. If there's a better way, I'm all ears!

    End With
    
    Set xDoc = Nothing
    Set xEmail = Nothing
    Set xOutlookObj = Nothing
    Application.ScreenUpdating = True

End Sub

The code opens an email with a template (not shown) and email addresses pre-populated.

How do I append the email addresses assigned to the Group3 variable to the end of the .to field?


Solution

  • Work with Inspectors object (Outlook) which has set of Inspector objects representing all inspectors

    Now assuming your subject line stays the same then search by subject and add to Group3

    Example


    Option Explicit
    Public Sub Example()
        Dim Outlook_App As Object
        Set Outlook_App = CreateObject("Outlook.Application")
        
        Dim Item As Outlook.MailItem
        
        Dim Inspectors As Outlook.Inspectors
        Set Inspectors = Outlook_App.Inspectors
        
        Call Contacts
        
        Dim i As Long
        If Inspectors.Count > 0 Then
            
            For i = Inspectors.Count To 1 Step -1
                
                If Inspectors.Item(i).CurrentItem.Class = olMail Then
                    Set Item = Inspectors.Item(i).CurrentItem
                    
                    If Item.Subject = "This is a Test" Then
                        Item.To = Item.To & ";" & Group3
                    End If
                    
                End If
                
            Next
            
        Else
            Debug.Print "No inspector windows are open."
        End If
    
    End Sub
    

    Add reference to Outlook library in VBA Editor, Tools, References