Changing the Sender to use Send on Behalf

0
votes

The scenario:

Two teams: MainTeam and HelpingTeam

MainTeam uses a shared mailbox exclusively and a macro sends all emails "on behalf of MainTeam" instead of sending-as the shared mailbox.

HelpingTeam users are going to help the other team. They need to indicate email is sent "on behalf of MainTeam".

The shared mailbox has been added to the users on the HelpingTeam and in a new mail window, the email address for the shared mailbox is below their personal one. Using this "From" address would indicate they are trying to SendAs the mailbox, which we don't want.

I could show them how to add another "From" address and set it up to use their primary account to "SendonBehalfOf", but they do not want to be confused because now they will see two entries in their "From" list: the "SendAs" entry (Fixed, can not be removed) and the "SendonBehalfOf" entry (can be removed).

I am trying to change the email properties so email will be sent on behalf of the shared mailbox.

  • When sending the email from the shared mailbox using this macro, everything works.
  • When initiating the email from a personal mailbox and changing the sender to the "SendAs" account (the only shared account in the list), the properties in the macro appear to be correct, but Outlook does not process the change and the system denies the message.

I've made so many revisions that I've lost track of what works and what doesn't. Below is the most functional version as described above. The MsgBox entries are to help me keep track of what is going on behind the scenes:

Dim oAccount As Outlook.Account
Dim objItem As MailItem
Dim WithEvents objInspectors As Outlook.Inspectors
Dim WithEvents objMailItem As Outlook.MailItem
Dim WithEvents myOlExp As Outlook.Explorer
Dim Sender As Outlook.AddressEntry

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

Public Sub SetFromAddress(objMailItem As Outlook.MailItem)
    'To see which account user is trying to send from
    MsgBox "[SetFromAddress] SendUsingAccount: " & objMailItem.SendUsingAccount
    MsgBox "[SetFromAddress] SentOnBehalfOfName: " & objMailItem.SentOnBehalfOfName
    
    'Check which account is in focus as primary
    If objMailItem.SendUsingAccount = "[email protected]" Then
        MsgBox "sendfromaddress if triggered"
        'set sender to be the Shared Mailbox
        objMailItem.SentOnBehalfOfName = "[email protected]"
          
        'Find Primary O365 account and use that to send the email "on behalf of"
        For Each oAccount In Application.Session.Accounts
            If oAccount = "[email protected]" Then
                objMailItem.SendUsingAccount = oAccount
            End If
        Next
    End If
    
    MsgBox "SetFromAddress Sending As: " & objMailItem.SendUsingAccount
    MsgBox "SetFromAddress OnBehalf: " & objMailItem.SentOnBehalfOfName
End Sub

'Below enables Outlook 2013/2016/365 Reading Pane Reply
Private Sub myOlExp_InlineResponse(ByVal objItem As Object)
    Call SetFromAddress(objItem)
End Sub

'Added the sub below in case the user manually switchs from personal to shared mailbox
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    MsgBox "[ItemSend] SendUsingAccount: " & Item.SendUsingAccount
    MsgBox "[ItemSend] SentOnBehalfOfName: " & Item.SentOnBehalfOfName
    
    'Check if Shared Account
    If Item.SentOnBehalfOfName = "[email protected]" Then
        MsgBox "If triggered"
        'set sender to be the Shared Mailbox
        Item.SentOnBehalfOfName = "[email protected]"
        
        'Find Primary O365 account and use that to send the email "on behalf of"
        For Each oAccount In Application.Session.Accounts
            If oAccount = "[email protected]" Then
                Item.SendUsingAccount = oAccount
            End If
        Next
    End If
    
    MsgBox "[ItemSend] SendUsingAccount: " & Item.SendUsingAccount
    MsgBox "[ItemSend] SentOnBehalfOfName: " & Item.SentOnBehalfOfName
End Sub

30/11/2020

This is how I am working around the issue for now, but it fails if it's an in-line reply:

Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
    Dim oAccount As Outlook.Account
    Dim objItem As MailItem
 
    'To test later which account user is trying to send from
    Set SendingAccount = item.SendUsingAccount
        
    'Check if Shared Account
    If SendingAccount = "[email protected]" Then

        'Intecept email, stop it from sending, and create a new one "on behalf of"
        If TypeOf item Is MailItem Then
            Set objItem = item.Copy
            item.Delete
            Cancel = True
                       
            'set sender to be the Shared Mailbox
            objItem.SentOnBehalfOfName = "[email protected]"
            
            'Find Primary O365 account and use that to send the email "on behalf of"
            For Each oAccount In Application.Session.Accounts
                If oAccount = "[email protected]" Then
                    objItem.SendUsingAccount = oAccount
                End If
            Next
        End If
        
        'send email
        objItem.Send
    End If
End Sub
2
vbaemailoutlooksend-on-behalf-of
.SentOnBehalfOfName is empty until mail is sent or it is assigned in the code. If important enough, the user would run code to assign it on every mail. Verify if empty in ItemSend then the user would assign a value. – niton

2 Answers

1
votes

Looks like I found a great work-around! While not the answer, it at least makes this code work. I basically sent the command to check names SendKeys "%k" (ALT+k), which checks both the sender and recipients field. While CTRL+k checks names on a new message, it will open the insert hyperlink window on a reply, which is why I went with ALT+k.

I added this at the end of the SetFromAddress and in for statement which checks for the correct sending account. I tested both inside and outside the for statement, but inside works every time.

Public Sub SetFromAddress(objMailItem As Outlook.MailItem)
    'To see which account user is trying to send from
    
    'Check which account is in focus as primary
    If objMailItem.SendUsingAccount = "[email protected]" Then
        'set sender to be the Shared Mailbox
        objMailItem.SentOnBehalfOfName = "[email protected]"
          
        'Find Primary O365 account and use that to send the email "on behalf of"
        For Each oAccount In Application.Session.Accounts
            If oAccount = "[email protected]" Then
                objMailItem.SendUsingAccount = oAccount
            End If
        Next
    End If
    SendKeys "%k
End Sub

and

            For Each oAccount In Application.Session.Accounts
                If oAccount = "[email protected]" Then
                    objItem.SendUsingAccount = oAccount
                    sendkeys (%k)
                End If
            Next
        End If

It's not perfect, but it will work for now until I can figure out how to tackle in-line responses.

0
votes

I have to trick Outlook into accepting SentOnBehalfOfName. Your setup may differ.

Dim oAccount As account

Const mailAddressShared = "[email protected]"

Private Sub setSentOnBehalfName()
    Dim currItem As MailItem
    Set currItem = ActiveInspector.currentItem
    Debug.Print currItem.subject
    currItem.SentOnBehalfOfName = mailAddressShared
    currItem.Save
End Sub

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

    Debug.Print "[ItemSend] SendUsingAccount: " & Item.SendUsingAccount
    Debug.Print "[ItemSend] SentOnBehalfOfName: " & Item.SentOnBehalfOfName
    
    Dim copiedItem As Object
    
    'Check if Shared Account
    If Item.SentOnBehalfOfName = mailAddressShared Then
    
        ' trick Outlook into accepting .SentOnBehalfOfName
        Set copiedItem = Item.Copy
        
        'assign shared mailbox
        copiedItem.SentOnBehalfOfName = mailAddressShared
        Debug.Print "copiedItem.SentOnBehalfOfName: " & copiedItem.SentOnBehalfOfName
    
    ElseIf Item.SentOnBehalfOfName = "" Then
    
        If MsgBox("Assign shared mailbox to SentOnBehalfOfName?", vbYesNo) = vbYes Then
        
            ' trick Outlook into accepting .SentOnBehalfOfName
            Set copiedItem = Item.Copy
            
            'assign shared mailbox
            copiedItem.SentOnBehalfOfName = mailAddressShared
            Debug.Print "copiedItem.SentOnBehalfOfName: " & copiedItem.SentOnBehalfOfName
            
        End If
        
    End If
    
    'Find default account to send the email
    If Not copiedItem Is Nothing Then
    
        Item.Delete
        Cancel = True   ' cancels original item
        
        For Each oAccount In Session.Accounts
            If oAccount = Session.GetDefaultFolder(olFolderInbox).Parent Then
                copiedItem.SendUsingAccount = oAccount
                Exit For
            End If
        Next
        
        Debug.Print "[ItemSend] copiedItem.SendUsingAccount: " & copiedItem.SendUsingAccount
        Debug.Print "[ItemSend] copiedItem.SentOnBehalfOfName: " & copiedItem.SentOnBehalfOfName
    
        copiedItem.Send ' does not re-trigger ItemSend
        
    Else
    
        Debug.Print "[ItemSend] Item.SendUsingAccount: " & Item.SendUsingAccount
        Debug.Print "[ItemSend] Item.SentOnBehalfOfName: " & Item.SentOnBehalfOfName
        
        For Each oAccount In Session.Accounts
            If oAccount = Session.GetDefaultFolder(olFolderInbox).Parent Then
                Item.SendUsingAccount = oAccount
                Exit For
            End If
        Next
    
        Debug.Print "[ItemSend] Item.SendUsingAccount: " & Item.SendUsingAccount
    End If
    
End Sub