preload
Nov 26

Automatically send an email copy to a special address with outlook 2007

Scripting, windows Add comments

It is not possible in Outlook to send an email blind carbon copy to a special email address automatically. E.g. you would like to send a copy of each email you send to watcher@mymail.com automatically.

A small Visual Basic Script can do the job. Open Outlook 2007 and press Alt+F11 for the Visual Basic Editor and put there the following code:

?View Code VBA
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

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
 
Dim objItem As MailItem
Dim myRecipients As Recipients
Dim myRecipient As Recipient
 
If Not ActiveInspector Is Nothing Then
If TypeOf ActiveInspector.CurrentItem Is MailItem Then
 
strBcc = "watcher@myemail.com"
End If
End If
 
On Error Resume Next
Set objRecip = Item.Recipients.Add(strBcc)
' handle case of user canceling Outlook security dialog
If Err = 287 Then
strMsg = "Could not add a Bcc recipient " & _
"because the user said No to the security prompt." & _
" Do you want still to send the message?"
res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
"Security Prompt Cancelled")
If res = vbNo Then
Cancel = True
Else
objRecip.Delete
End If
Err.Clear
Else
objRecip.Type = olBCC
objRecip.Resolve
 
End If
 
Set objRecip = Nothing
 
End Sub

Here is another version where you can filter the recipients and send mails to a special email address. E.g. you would like to send a bcc automatically to company1@mymail.com if you send mails to *@company1.com and to company2@mymail.com if you send mails to *@company2.com:

?View Code VBA
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54

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
 
Dim objItem As MailItem
Dim myRecipients As Recipients
Dim myRecipient As Recipient
 
If Not ActiveInspector Is Nothing Then
If TypeOf ActiveInspector.CurrentItem Is MailItem Then
Set objItem = ActiveInspector.CurrentItem
Set myRecipients = objItem.Recipients
myRecipients.ResolveAll
For Each myRecipient In myRecipients
 
strBcc = ""
 
If InStr(myRecipient.Address, "company1.com") Then
strBcc = "company1@mymail.com"
End If
If InStr(myRecipient.Address, "company2.com") Then
strBcc = "company2@mymail.com"
End If
 
Next
End If
End If
 
On Error Resume Next
Set objRecip = Item.Recipients.Add(strBcc)
' handle case of user canceling Outlook security dialog
If Err = 287 Then
strMsg = "Could not add a Bcc recipient " & _
"because the user said No to the security prompt." & _
" Do you want still to send the message?"
res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
"Security Prompt Cancelled")
If res = vbNo Then
Cancel = True
Else
objRecip.Delete
End If
Err.Clear
Else
objRecip.Type = olBCC
objRecip.Resolve
 
End If
 
Set objRecip = Nothing
 
End Sub

Leave a Reply

You must be logged in to post a comment.