场景：
两个团队：MainTeam和HelpingTeam
MainTeam 独占使用共享邮箱，宏“代表MainTeam ”发送所有电子邮件，而不是作为共享邮箱发送。
HelpingTeam用户将帮助其他团队。他们需要表明电子邮件是“代表MainTeam ”发送的。
共享邮箱已添加到HelpingTeam上的用户，在新的邮件窗口中，共享邮箱的电子邮件地址低于他们的个人邮箱地址。使用这个“发件人”地址将表明他们正在尝试发送邮箱，这是我们不想要的。
我可以向他们展示如何添加另一个“发件人”地址并将其设置为使用他们的主帐户到“SendonBehalfOf”，但他们不想混淆，因为现在他们将在“发件人”列表中看到两个条目：“ SendAs”条目（固定，不能删除）和“SendonBehalfOf”条目（可以删除）。
我正在尝试更改电子邮件属性，以便代表共享邮箱发送电子邮件。
- 使用此宏从共享邮箱发送电子邮件时，一切正常。
- 从个人邮箱发起电子邮件并将发件人更改为“SendAs”帐户（列表中唯一的共享帐户）时，宏中的属性似乎正确，但 Outlook 不处理更改，系统拒绝信息。
我做了很多修改，以至于我忘记了哪些有效，哪些无效。以下是如上所述的最实用的版本。MsgBox条目是为了帮助我跟踪幕后发生的事情：
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 = "MainTeam@company.com" Then
MsgBox "sendfromaddress if triggered"
'set sender to be the Shared Mailbox
objMailItem.SentOnBehalfOfName = "MainTeam@company.com"
'Find Primary O365 account and use that to send the email "on behalf of"
For Each oAccount In Application.Session.Accounts
If oAccount = "U.ser@company.com" 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 = "MainTeam@company.com" Then
MsgBox "If triggered"
'set sender to be the Shared Mailbox
Item.SentOnBehalfOfName = "MainTeam@company.com"
'Find Primary O365 account and use that to send the email "on behalf of"
For Each oAccount In Application.Session.Accounts
If oAccount = "U.ser@company.com" Then
Item.SendUsingAccount = oAccount
End If
Next
End If
MsgBox "[ItemSend] SendUsingAccount: " & Item.SendUsingAccount
MsgBox "[ItemSend] SentOnBehalfOfName: " & Item.SentOnBehalfOfName
End Sub
2020 年 11 月 30 日
这就是我现在解决这个问题的方式，但如果它是一个在线回复，它会失败：
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 = "MainTeam@company.com" 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 = "MainTeam@company.com"
'Find Primary O365 account and use that to send the email "on behalf of"
For Each oAccount In Application.Session.Accounts
If oAccount = "U.ser@company.com" Then
objItem.SendUsingAccount = oAccount
End If
Next
End If
'send email
objItem.Send
End If
End Sub