How to add From to all emails in Outbox

[Eperluette]

Hello everyone,

I have this mail merge that sends emails to the Outbox where they stay as long as I work offline.

What I was hoping to do is modify the 'From' field so all emails in Outbox will eventually be sent as "(my email) on behalf of (another email)". I have the authorisation from the other person to send emails on their behalf and can do it manually, but would like to be able to do it for all emails at once before sending.

In the forum, I found the following thread very useful: How to add Bcc to all emails in Outbox >>not always the same Bcc<<

I thought I could modify the macro provided in the above thread by changing Bcc to SentOnBehalfOfName in order to edit the From field:

Sub From_field()
Dim olItems As Outlook.Items
Dim olItem As Outlook.MailItem
Dim objRecip As Outlook.recipient
Dim strSentOnBehalfOfName As String
    Set olItems = Session.GetDefaultFolder(olFolderOutbox).Items
    strSentOnBehalfOfName = InputBox("Enter the From Email Address")
    For Each olItem In olItems
        If InStr(UCase(olItem.Subject), "") > 0 Then
            Set objRecip = olItem.recipients.Add(strSentOnBehalfOfName)
            objRecip.Type = olSentOnBehalfOfName
            olItem.Save
            olItem.Send
        End If
    Next olItem
    Set olItems = Nothing
    Set olItem = Nothing
    Set objRecip = Nothing
End Sub

...but it doesn't seem to do anything, so unfortunately it is not as easy as I thought...

As ever, any help or suggestions would be gratefully received! (I am using Outlook 2010).

Thank you,

Sarah

[gmayor]

Is this an Exchange account? If so you probably require something like

 olItem.SentOnBehalfOfName = "someone@somewhere.com"

If not you will have to change the sending account

[Eperluette]

Dear Graham,

Thank you so much for your fast reply! It is an Exchange account indeed.

I have modified the code as follows and it now works perfectly:

Sub From_field()
Dim olItems As Outlook.Items
Dim olItem As Outlook.MailItem
Dim objRecip As Outlook.recipient
Dim strSentOnBehalfOfName As String
    Set olItems = Session.GetDefaultFolder(olFolderOutbox).Items
    For Each olItem In olItems
        If InStr(UCase(olItem.Subject), "") > 0 Then
            olItem.SentOnBehalfOfName = "email"
            olItem.Save
            olItem.Send
        End If
    Next olItem
    Set olItems = Nothing
    Set olItem = Nothing
    Set objRecip = Nothing
End Sub

Cheers,

Sarah