Outlook 2016 を介して送信するすべての電子メールに .SentOnBehalfOfName を設定しようとしています。つまり、新しいメール、返信、全員に返信、または転送を押すたびにです。
私はこれを試しました：
Public WithEvents myItem As Outlook.MailItem
Private Sub Application_ItemLoad(ByVal Item As Object)
If (TypeOf Item Is MailItem) Then
Set myItem = Item
End If
End Sub
Private Sub FromField()
With myItem
.SentOnBehalfOfName = "example@aol.com"
.Display
End With
End Sub
Private Sub myItem_Open(Cancel As Boolean)
FromField
End Sub
SentOnBehalfOfNameプロパティは、Exchange プロファイル/アカウントの場合にのみ意味があります。さらに、別の人に代わって送信するために必要な権限が必要です。同様の議論については、 SentOnBehalfOfName に関する問題を参照してください。
プロファイルに複数のアカウントが構成されている場合は、SendUsingAccountプロパティを使用して、MailItem が送信されるアカウントを表す Account オブジェクトを使用できます。
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
oMail.SendUsingAccount = oAccount
oMail.Send
End If
Next
End Sub
このOutlookSessionで
Private WithEvents sentInsp As Inspectors
Private WithEvents sentMailItem As mailItem
Private Sub Application_Startup()
Set sentInsp = Application.Inspectors
End Sub
Private Sub sentInsp_NewInspector(ByVal Inspector As Inspector)
If Inspector.currentItem.Class = olMail Then
Set sentMailItem = Inspector.currentItem
sentMailItem.SentOnBehalfOfName = "someone@someplace.com"
End If
End Sub
定期的にスタートアップを実行して、イベント コードをリセットする必要があることがわかりました。ItemSend の方が信頼性が高い場合があります。
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim copiedItem As MailItem
If Item.Class = olMail Then
Set copiedItem = Item.Copy
copiedItem.SentOnBehalfOfName = "someone@someplace.com"
'copiedItem.Display
copiedItem.Send
Item.Delete
Cancel = True
End If
Set copiedItem = Nothing
End Sub
このコードを実行すると、ItemSend が再度呼び出されません。
代わりに Application.ItemSend イベントを使用してください。