CC without attachments using Outlook VBA

In Tip 669: CC without attachments?, Outlook MVP Diane Poremsky writes

We get often get questions from users who would like to have the option to send attachments only to the To-list, with the CC and BCC recipients just getting the message without the attachment.

Diane correctly responds that this isn't possible in Outlook. Not directly anyway, unless you want to use VBA to accomplish the same task.

Personally I think it's strange, because in the email you'll write "see attachment" and the B/CC recipients will write you back and say "we didn't get any attachment." Then you have to reveal that you really don't like them and didn't want to send them anything, which could hasten your exit from the company. The question becomes: why are you working with people you can't trust?

Then again, the CC might be your boss, who wants to see that you're working but doesn't actually need every single attachment you'll bounce around your office.

As I explained in I made it into the EMO Newsletter, the best solution would be to put the file on a network share, or upload to a file sharing service. This wouldn't stop the B/CC recipients from opening the files, however.

But you didn't come here to hear that, did you? Here's a kludgy workaround that takes a given email and splits it into two emails:

The original email with attachments, sent to everyone in the To field.
A copy of the original email, sans attachments, sent to everyone in the CC field.

You will also end up with two conversation threads to track (another drawback). Don't say I didn't warn you.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

  On Error GoTo ErrorHandler

  Dim bccRecipients As String
  Dim ccRecipients As String
  Dim msg As Outlook.MailItem
  Dim attachs As Outlook.Attachments
  Dim newMsg As Outlook.MailItem
  Dim newMsgAttachs As Outlook.Attachments
  Dim newMsgattach As Outlook.Attachment
  Dim newRecips As Outlook.Recipients
  Dim recip As Outlook.recipient
  Dim recips As Outlook.Recipients

  Set msg = Item
  Set attachs = msg.Attachments

  ' make sure you want to split the email
  If attachs.Count &gt; 0 Then
    If MsgBox(&quot;Do you want to send the attachments&quot; &amp; _
            &quot; ONLY to the To recipients?&quot;, vbYesNo) &lt;&gt; vbYes Then
      GoTo ProgramExit
    End If
  End If

  Set recips = msg.Recipients

  ' make list of CC and BCC recips
  For Each recip In recips
    Select Case recip.Type
      Case olCC  ' 2
        ccRecipients = ccRecipients &amp; recip.Address &amp; &quot;;&quot;
        recip.Delete
      Case olBCC  ' 3
        bccRecipients = bccRecipients &amp; recip.Address &amp; &quot;;&quot;
        recip.Delete
    End Select
  Next recip

  ' create a copy of the email, strip the attachments
  ' and send to the CC and BCC recipients
  ' CC recipients will become To recipients in the new email,
  ' BCC recipients will stay BCC recipients
  Set newMsg = msg.Copy
  Set newRecips = newMsg.Recipients
  Set newMsgAttachs = newMsg.Attachments

  For Each newMsgattach In newMsgAttachs
    newMsgattach.Delete
  Next newMsgattach

  For Each recip In newRecips
    recip.Delete
  Next recip

  With newMsg
    .To = ccRecipients
    .BCC = bccRecipients
    .Send
  End With

ProgramExit:
  Exit Sub
ErrorHandler:
  MsgBox Err.number &amp; &quot; - &quot; &amp; Err.Description
  Resume ProgramExit
End Sub

I compiled but didn't actually test this; if anyone tries it out, let me know if it works.