How to add Bcc to all emails in Outbox >>not always the same Bcc<<

[pk247]

Hi All,

I'm hoping someone can help to adapt the code below if at all possible - or even point me in the right direction. I'm ok with vba but don't have much experience with Outlook unfortunately.

Basically this is what happens:
1/ I create a mail merge (from hundreds of different templates) and when I mail merge I type in the subject line the word "ACCESS" and some extra words
2/ I have a rule set up in Outlook to capture "ACCESS" in the subject line and stay there for ten minutes in the Outbox - this is so I can manually Bcc an email address that is in our company's public folder so that a record is kept and so that I can attach a document if need be (attaching isn't that too often though)
3/ The emails send after ten minutes and everything is done :)

The code below lets me capture the mail merged emails and prompts me to add the Bcc, which is great but I'm sure the following can be done:
Click a saved macro that opens an input box in which I paste the public folder email address then the code loops through all the emails in the Outbox and adds the Bcc email address. Would anyone be able to help me do this at all please? It would save me so much time each day to get on with other work...

Thank you so much if you can help,
Paul, from not-so-sunny Ireland

The code which I've found via trawling through the web and adapted so far is:




Private Sub Application_ItemSend(ByVal Item As Object, _
Cancel As Boolean)
Dim objRecip As recipient
Dim strMsg As String
Dim res As Integer
Dim strBcc As String
On Error Resume Next
Dim Subject As String

Subject = item.Subject

If InStr(UCase(Item.Subject), "ACCESS") > 0 Then
strBcc = InputBox("Enter the Bcc Email Address from the Excel list", Warning)

Set objRecip = Item.Recipients.Add(strBcc)
objRecip.Type = olBCC

With objEmail

Call .Recipients.ResolveAll
End With

If Not objRecip.Resolve Then
strMsg = "Could not resolve the Bcc recipient. " & _
"Do you want still to send the message?"
res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
"Could Not Resolve Bcc Recipient")
If res = vbNo Then
Cancel = True
End If
End If

Set objRecip = Nothing
End If
End Sub

[gmayor]

If you sent Outlook not to send immediately, you don't need the rule to delay the send. Personally I always choose not to send immediately as that minimises the possibility of sending mail you didn't intend to send.

The basic macro to add BCC to appropriate messages would be.


Sub AddBCC()
Dim olItems As Outlook.Items
Dim olItem As Outlook.MailItem
Dim objRecip As Outlook.Recipient
Dim strBCC As String
Set olItems = Session.GetDefaultFolder(olFolderOutbox).Items
strBCC = InputBox("Enter the Bcc Email Address from the Excel list")
For Each olItem In olItems
If InStr(UCase(olItem.Subject), "ACCESS") > 0 Then
Set objRecip = olItem.Recipients.Add(strBCC)
objRecip.Type = olBCC
olItem.Save
olItem.sEnd
End If
Next olItem
Set olItems = Nothing
Set olItem = Nothing
Set objRecip = Nothing
End Sub

Note that if your data is Excel - you could use http://www.gmayor.com/ManyToOne.htm to merge to e-mail, and this provides various options for including BCC addresses, either fixed or from the data source, and/or the addition of attachments. In one to one mode the add-in emulates conventional merge to e-mail, though mail merge is not really invoved other than as a means to position the data.

[pk247]

Thank you so much Graham!! That works perfectly :)
I don't want to overstep the mark here but since you provided this brilliant response so quickly could you advise if the following is possible please?

Once the Mail Merge is complete could Outlook prompt me automatically to run the Bcc macro at all? I imagine the code would need to be in the "ThisOutlookSession" but I don't really know where to start. Could the prompt also open the address book as that is where I could acquire the public folder email address. I would like this so that I never forget of if I get sidetracked I can't go any further with Outlook until I have Bcc'd the appropriate email address.

Even if you can advise whether or not this is possible that would at least let me know. Thank you so much so far though!

Paul, Ireland