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