Automatically "Send on Behalf Of" when sent from a specific email account

Question

I could use assistance modifying the Outlook VBA macro. Any time I reply to an e-mail from any of my multiple e-mail accounts the script will change the sender address to the one specified (i.e. [email protected] on behalf of [email protected]). I like this behavior but need help making a change so that this script only runs when I am sending from an email address @domain.com. Essentially I would like the macro to have an if statement specifying if sending from an @domain.com email account then run the macro otherwise if sending from another email account i.e. [email protected] do not run the macro.

'================================================================================
'Description: Outlook macro to automatically set a different
'             From address.
'
'Comment: You can set the email address at the bottom of the code.
'         Uncomment the myOlExp_InlineResponse sub to also make it
'         work with the Reading Pane reply feature of Outlook 2013/2016/2019/365.
'
' author : Robert Sparnaaij
' version: 1.1
' website: https://www.howto-outlook.com/howto/setfromaddress.htm
'================================================================================

Dim WithEvents objInspectors As Outlook.Inspectors
Dim WithEvents objMailItem As Outlook.MailItem
Dim WithEvents myOlExp As Outlook.Explorer

Private Sub Application_Startup()
    Initialize_handler
End Sub

Public Sub Initialize_handler()
    Set objInspectors = Application.Inspectors
    Set myOlExp = Application.ActiveExplorer
End Sub

Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
    If Inspector.CurrentItem.Class = olMail Then
        Set objMailItem = Inspector.CurrentItem
        If objMailItem.Sent = False Then
            Call SetFromAddress(objMailItem)
        End If
    End If
End Sub

'Uncomment the next 3 lines to enable Outlook 2013/2016/2019/365 Reading Pane Reply
'Private Sub myOlExp_InlineResponse(ByVal objItem As Object)
'    Call SetFromAddress(objItem)
'End Sub

Public Sub SetFromAddress(oMail As Outlook.MailItem)
    ' Set your preferred default From address below.
    ' Exchange permissions determine if it is actually stamped
    ' as "Sent On Behalf Of" or "Sent As".
    ' The address is not properly updated for the InlineResponse
    ' feature in Outlook 2013/2016/365. This is only a visual bug.
    oMail.SentOnBehalfOfName = "[email protected]"
End Sub

Answer 1

If you want to handle outgoing emails you need to subscribe to the ItemSend event of the Application class which is fired whenever an Microsoft Outlook item is sent, either by the user through an Inspector (before the inspector is closed, but after the user clicks the Send button) or when the Send method for an Outlook item, such as MailItem, is used in a program.

Public WithEvents myOlApp As Outlook.Application 
 
Public Sub Initialize_handler()  
 Set myOlApp = Outlook.Application  
End Sub 
 
Private Sub myOlApp_ItemSend(ByVal Item As Object, Cancel As Boolean)  
 Dim prompt As String  
 prompt = "Are you sure you want to send " & Item.Subject & "?"  
 If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbNo Then  
 Cancel = True  
 End If  
End Sub

In the event handler you may check out the MailItem.SendUsingAccount property which allows setting an Account object that represents the account under which the MailItem is to be sent. The SendUsingAccount property can be used to specify the account that should be used to send the MailItem when the Send method is called.

Depending on the account set on the mail item you may want to set the MailItem.SentOnBehalfOfName property which returns a string indicating the display name for the intended sender of the mail message. You may need to cancel the default action and re-submit the item anew programmatically.

Answer 2

Navigate the folder tree up to the email address folder.

This should be objMailItem.Parent.Parent.

Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
        
    If Inspector.currentItem.Class = olMail Then
        Set objMailItem = Inspector.currentItem
        If objMailItem.Sent = False Then
            
            Debug.Print objMailItem.Parent.Parent
            If InStr(LCase(objMailItem.Parent.Parent), LCase("@domain.com")) Then
                Call SetFromAddress(objMailItem)
            End If
            
        End If
    End If
End Sub

Answer 3

For anyone who finds this. This should work if you already have the primary account setup in outlook and the account you want to send from has "send on behalf" or "send as" permission:

Dim WithEvents objInspectors As Outlook.Inspectors
Dim WithEvents objMailItem As Outlook.MailItem
Dim WithEvents myOlExp As Outlook.Explorer

Private Sub Application_Startup()
    Initialize_handler
End Sub

Public Sub Initialize_handler()
    Set objInspectors = Application.Inspectors
    Set myOlExp = Application.ActiveExplorer
End Sub

Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
    If Inspector.CurrentItem.Class = olMail Then
        Set objMailItem = Inspector.CurrentItem
        If objMailItem.Sent = False Then
            Call SetFromAddress(objMailItem)
        End If
    End If
End Sub

'Uncomment the next 3 lines to enable Outlook 2013/2016/2019/365 Reading Pane Reply
'Private Sub myOlExp_InlineResponse(ByVal objItem As Object)
    'Call SetFromAddress(objItem)
'End Sub

Public Sub SetFromAddress(oMail As Outlook.MailItem)
    ' Set your preferred default From address below.
    ' Exchange permissions determine if it is actually stamped
    ' as "Sent On Behalf Of" or "Sent As".
    ' The address is not properly updated for the InlineResponse
    ' feature in Outlook 2013/2016/365. This is only a visual bug.
    If oMail.SendUsingAccount = "primary@domain" Then
        oMail.SentOnBehalfOfName = "delegate@domain"
    End If
End Sub