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("[email protected]")
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("[email protected]")
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
CodePudding user response:
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:
- 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("[email protected]")
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
- The MailItem.SendUsingAccount property returns or sets an
Account
object that represents the account under which theMailItem
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 ("[email protected]")
oMail.Recipients.ResolveAll
Set oMail.SendUsingAccount = oAccount
oMail.Send
End If
Next
End Sub