Измените значение Item.To в outlook при отправке сообщения с использованием VBA.

Question

Я пытаюсь изменить адрес электронной почты в поле «Отправить» в Outlook, когда пользователь нажимает кнопку «Отправить».например, если текущее значение Item.To = 'aaa@example.com' становится 'bbb@example.com'.

Я могу сменить тему, но не удалось с Item.To (это проблема безопасности?):

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

   If Item.Class <> olMail Then Exit Sub

   Item.To = "bbb@example.com"  ' Nope , It does not work
   Item.Subject = "New Subject" ' It works

End Sub

Спасибо

Answer 1

Свойство MailItem.To используется только для отображаемых имен. Возможно, вы захотите использовать коллекцию получателей, как в этом слегка измененном примере из справки Outlook по свойству MailItem.Recipients:

Sub CreateStatusReportToBoss()

 Dim myItem As Outlook.MailItem
 Dim myRecipient As Outlook.Recipient

 Set myItem = Application.CreateItem(olMailItem)
 Set myRecipient = myItem.Recipients.Add("bbb@example.com")
 myItem.Subject = "New Subject"
 myItem.Display

End Sub

Answer 2

Я владелец вопроса. Я выбрал ответ @joeschwa, но также хочу отобразить свой код, который отменяет текущее сообщение и создает новое (вы можете изменить получателей, содержимое сообщения и все остальное):

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

   If Item.Class <> olMail Then Exit Sub
   Dim newEm As String

   Dim Rec As Recipient
        Dim myItem As Outlook.MailItem
        Dim myRecipient As Outlook.Recipient
        Set myItem = Application.CreateItem(olMailItem)
        myItem.Body = Item.Body
        myItem.HTMLBody = Item.HTMLBody
        myItem.Subject = Item.Subject & " RASEEL PLUGIN "
        Cancel = True


   For Each Rec In Item.Recipients
    If InStr(1, Rec.AddressEntry, "@example.com", vbTextCompare) Then
        newEm = "example@example.net"
    Else
        newEm = Rec.AddressEntry
   End If

    Set myRecipient = myItem.Recipients.Add(newEm)
    myRecipient.Type = Rec.Type

   Next

   myItem.Send

End Sub

Answer 3

Это работает для меня.Однако при смене получателя также необходимо сначала удалить предыдущего получателя.Например,

x = .recipients.count , если x = 1, то .recipients (1) .delete
.recipients.add "abc@dfg.com"