vbaemailoutlooksend-on-behalf-of

Outlook vba send email from SharedMailbox without the "Sent on behalf"

I have been struggling to programmatically send an email as a Shared Mailbox and NOT on behalf of.

I have tried this code that I can't remember now from where I took it, did a few modifications to it.

Public Sub test()

    Dim outApp As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Recipient
    Dim Recipients As Recipients
    Dim addrEntry As Outlook.AddressEntry
    Dim addrEntries As Outlook.AddressEntries
    Dim nameSpace As Outlook.nameSpace
    Dim addrLists As Outlook.AddressLists
    Dim uMailInbox As Outlook.Recipient
     
    Set outApp = CreateObject("Outlook.Application")
    Set objOutlookMsg = outApp.CreateItem(olMailItem)
    Set nameSpace = outApp.GetNamespace("MAPI")
    Set addrLists = nameSpace.Session.AddressLists
    
    Set addrEntry = addrLists.Item("Global Address List").AddressEntries.Item("testSender")

    Set Recipients = objOutlookMsg.Recipients
    Set objOutlookRecip = Recipients.Add("testReceiver@testdomain.com")
    objOutlookRecip.Type = 1
    
    objOutlookMsg.Sender = addrEntry
    
'    Debug.Print objOutlookMsg.SentOnBehalfOfName
    
    objOutlookMsg.Subject = "Testing this macro"
    objOutlookMsg.HTMLBody = "Testing this macro" & vbCrLf & vbCrLf
    
    For Each objOutlookRecip In objOutlookMsg.Recipients
        objOutlookRecip.Resolve
    Next
    
    objOutlookMsg.Display
    objOutlookMsg.Send
    
    Set outApp = Nothing

End Sub

I have also given the following permissions to the account used on the outlook app: -Read and manage permissions -Send as permissions

And purposely not given the permission: -Send on behalf of permission

Still the received email has the quote "sent on behalf of"

A second approach suggested adding the account of the Shared Mailbox to the outlook accounts and then send the email using the second account corresponding to the Shared Mailbox. However using this approach I still got the "sent on behalf of" quote, even though all this time I didn't have the "Send on behalf of permission"

Finally a third approach here suggested creating the email item from the folder outlook of the Shared Mailbox.

Public Sub test2()

    Dim outApp As Outlook.Application
    Dim trgtStore As Outlook.Store
    Dim trgtFolder As Outlook.Folder
    Dim emailItem As Outlook.MailItem
    Dim recip As Outlook.Recipient
    Dim addrEntry As Outlook.AddressEntry
    Dim addrLists As Outlook.AddressLists
    Dim nameSpace As Outlook.nameSpace
    
    Set outApp = CreateObject("Outlook.Application")
    Set trgtStore = outApp.Session.Stores("testSender")
    
    Set trgtFolder = trgtStore.GetDefaultFolder(4) ' olFolderOutbox = 4
    Set emailItem = trgtFolder.Items.Add
    
    Set nameSpace = outApp.GetNamespace("MAPI")
    Set addrLists = nameSpace.Session.AddressLists
    
    Set addrEntry = addrLists.Item("Global Address List").AddressEntries.Item("testSender")
    
    With emailItem
        
        Set recip = .Recipients.Add("testReceiver@testdomain.com")
        recip.Type = 1 'olTo = 1  olOriginator = 0 olCC = 2 olBCC = 3
        .Subject = "Testing this macro"
        .HTMLBody = "Testing this macro" & vbCrLf & vbCrLf
        .Sender = addrEntry
        .Display
        .Send
        
    End With
    
End Sub

Every time I get the "sent on behalf of" quote on the received email... Can anyone help with this issue please?

Best regards

Solution

  • The Sender property is read-only, so you can't set it in the following way:

    objOutlookMsg.Sender = addrEntry

    Instead, you can use two possible options:

    1. The MailItem.SentOnBehalfOfName property which returns a string indicating the display name for the intended sender of the mail message. Inthat case you need to make sure that you have the permissions to send on behalf of another person.
    Set addrEntry = addrLists.Item("Global Address List").AddressEntries.Item("testSender")
    
    With emailItem
        
        Set recip = .Recipients.Add("testReceiver@testdomain.com")
        recip.Type = 1 'olTo = 1  olOriginator = 0 olCC = 2 olBCC = 3
        .Subject = "Testing this macro"
        .HTMLBody = "Testing this macro" & vbCrLf & vbCrLf
        .SentOnBehalfOfName = addrEntry.Name
        .Display
        .Send
        
    End With
    1. The MailItem.SendUsingAccount property returns or sets an Account object that represents the account under which the MailItem is to be sent. Note, the account should be configured in Outlook. For example:
    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 
     Set oMail.SendUsingAccount = oAccount 
     oMail.Send 
   End If 
 Next 
End Sub