BCC someone if they press yes on the popup

[simon270893]

Hi I am looking for a outlook VBA code that i can use.

when someone hits send i need it to bring up a popup asking if there are any drawings attached, if yes it needs to BCC an email address, if not it just sends normally.

I am a complete beginner and cannot figure it out!

Any help would be appreciated



Simon

[gmayor]

The following macro in the ThisOutlookSession module of the VBA project will examine each outgoing message. If the message has attachments, then the filename of the attachments are checked for the extension(s) of the filenames. If the extension matches the list, the user sees a message prompt (unless the image is named image*.* which would suggest a graphic in the message body. ) Depending on the prompt a BCC to the indicated e-mail address is added.


Option Explicit

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim oAttach As Attachment
Dim oRecip As Recipient
Dim lngAsk As Long
If Item.Attachments.Count > 0 Then
For Each oAttach In Item.Attachments
Select Case Right(LCase(oAttach.fileName), 3)
Case "jpg", "bmp", "png", "tif", "gif" 'the extension(s) of the drawing filename(s)
If Not olAttach.fileName Like "image*.*" Then 'Optional check
lngAsk = MsgBox("Are there drawings attached?", vbYesNo)
If lngAsk = vbYes Then
Item.BCC = "someone@somewhere.com" 'the BCC address
For Each oRecip In Item.Recipients
oRecip.Resolve
Next oRecip
End If
End If 'Remove this line if the optional check line is removed.
Case Else
End Select
Next oAttach
End If
lbl_Exit:
Set oRecip = Nothing
Set oAttach = Nothing
Exit Sub
End Sub

[simon270893]

Hi Graham

That perfect and does exactly what i want, HOWEVER :)

I have to press YES around 5-6 times before it sends

Thanks again

[skatonni]

Try breaking out of the loop after the first response.


Case "jpg", "bmp", "png", "tif", "gif" 'the extension(s) of the drawing filename(s)
If Not oAttach.fileName Like "image*.*" Then 'Optional check
lngAsk = MsgBox("Are there drawings attached?", vbYesNo)
If lngAsk = vbYes Then
Item.BCC = "someone@somewhere.com" 'the BCC address
For Each oRecip In Item.Recipients
oRecip.Resolve
Next oRecip
End If

GoTo lbl_Exit ' <--

End If 'Remove this line if the optional check line is removed.

[gmayor]

Hi Graham
That perfect and does exactly what i want, HOWEVER :)
I have to press YES around 5-6 times before it sends
Thanks againIt will prompt for each attachment that meets the criteria.
Add the line

Exit For
after the line

Next oRecip