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... :think:

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