Set .SentOnBehalfofName on every email sent

Question

I am trying to set the .SentOnBehalfOfName on every email I send through Outlook 2016. That is, whenever I hit New Mail, Reply, Reply All, or Forward.

I tried this:

Answer 1

Use the Application.ItemSend event instead.

Answer 2

In ThisOutlookSession

Private WithEvents sentInsp As Inspectors
Private WithEvents sentMailItem As mailItem

Private Sub Application_Startup()
    Set sentInsp = Application.Inspectors
End Sub

Private Sub sentInsp_NewInspector(ByVal Inspector As Inspector)
    If Inspector.currentItem.Class = olMail Then
       Set sentMailItem = Inspector.currentItem
       sentMailItem.SentOnBehalfOfName = "someone@someplace.com"
    End If
End Sub

I have found my event code has to be reset by running startup at intervals. ItemSend may be more reliable.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim copiedItem As MailItem

If Item.Class = olMail Then

    Set copiedItem = Item.Copy

    copiedItem.SentOnBehalfOfName = "someone@someplace.com"
    'copiedItem.Display
    copiedItem.Send

    Item.Delete
    Cancel = True

End If

    Set copiedItem = Nothing

End Sub

When I run this code it does not call ItemSend again.

Answer 3

The SentOnBehalfOfName property makes sense only in case of Exchange profiles/accounts. Moreover, you need to have the required permissions to send on behalf of another person. See Issue with SentOnBehalfOfName for a similar discussion.

In case if you have multiple accounts configured in the profile you can use the SendUsingAccount property which allows to an Account object that represents the account under which the MailItem is to be sent.

 Sub SendUsingAccount() 
  Dim oAccount As Outlook.account 
  For Each oAccount In Application.Session.Accounts 
   If oAccount.AccountType = olPop3 Then 
    Dim oMail As Outlook.MailItem 
    Set oMail = Application.CreateItem(olMailItem) 
    oMail.Subject = "Sent using POP3 Account" 
    oMail.Recipients.Add ("someone@example.com") 
    oMail.Recipients.ResolveAll 
    oMail.SendUsingAccount = oAccount 
    oMail.Send 
   End If 
  Next 
 End Sub