Question

我想在发送邮件时更改收件人的电子邮件地址。我不知道我是否应该使用item.to或rec.addressentry或myrecipient。

我希望它能像你输入example@mail.com一样工作，然后将它发送到example2@mail.com，它可以在按下发送按钮时重写，或者只是发送到example2。

我想在启动时启动宏，所以它应该在启动事件之后，我想它应该是itemsend事件。

我试过这些：不工作

'Item = MailItem
     If Item.To = "example@mail.com" Then
         Item.To = "example2@mail.com"

不会关闭消息窗口

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
        Cancel = True


    If InStr(1, Rec.AddressEntry, "example@mail.com", vbTextCompare) Then
        newEm = "example2@mail.com"

   End If

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

   myItem.Send

End Sub

Answer 1

试试这个：

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

Item.To = ChangeSMTPRecipient(Item, "example@mail.com", "example2@mail.com")

End Sub

Function ChangeSMTPRecipient(mail As Outlook.MailItem, FromSMTP, ToSMTP) As String
On Error Resume Next
    Dim recips As Outlook.Recipients
    Dim recip As Outlook.Recipient
    Dim pa As Outlook.propertyAccessor
    Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

    ChangeSMTPRecipient = ""

    Set recips = mail.Recipients
    For Each recip In recips
        Set pa = recip.propertyAccessor
        RecipNew = pa.GetProperty(PR_SMTP_ADDRESS)
        If RecipNew = FromSMTP Then RecipNew = ToSMTP
        ChangeSMTPRecipient = ChangeSMTPRecipient & IIf(ChangeSMTPRecipient = "", "", "; ") &     RecipNew
    Next
On Error GoTo 0
    End Function

outlook宏更改item.to发送邮件时收件人地址

1 个答案: