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

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. user#domain.com on behalf of group#domain.com). 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. user#gmail.com 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 = "delegate#domain.com"
End Sub

Answer 1

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 2

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 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