HOWTO: rewrite an email address on send in outlook

I’m not terribly big on microsoft products, but I have to use them at work. I was emailing someone whos reply-to address was incorrect, so I needed to rewrite it on send. It was terribly annoying to have to remember to replace it everytime I hit “reply.”

Here’s some code that does it.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    'Trying to rewrite an email address on send
    Dim item2 As MailItem
    If TypeOf Item Is MailItem Then
        Set item2 = Item
        Dim str As String
        Dim r As Recipient
        For Each r In item2.Recipients
        If r.Address = "old.address@someplace.net" Then
            r.Delete
            Dim newRecipient As Recipient
            Set newRecipient = item2.Recipients.Add("new.address@something.more.useful.com")
            newRecipient.Type = olTo
            newRecipient.Resolve
        End If
        Next
    End If
End Sub

Share and Enjoy: