Outlook VBA实现共享邮箱直接发邮件,去除‘代表发送’标识
从共享邮箱直接发送邮件(非代表发送)的问题求助
已为Outlook所用账户配置共享邮箱的读取和管理权限及发送权限,特意未配置「代表发送权限」,但通过编程发送邮件时,收件方始终看到「代表发送」标识。先后尝试以下三种方案均未解决问题:
方案1:直接创建邮件并设置Sender
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
方案2:添加共享邮箱至Outlook账户列表后发送
将共享邮箱账户添加到Outlook的账户列表中,使用该账户直接发送邮件,问题依旧存在。
方案3:从共享邮箱发件箱创建邮件项
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
所有方案均未解决问题,收件端始终显示「代表发送」标识,恳请提供可行的解决方案。
内容的提问来源于stack exchange,提问作者David
相关产品推荐
相关产品推荐

