prevent sending certain file types - possible?

[rolandofeld]

Hi All

I would like to know if it is possible to prevent sending an .xlsm file type in Outlook 2016 via vba script?

The environment I am in there is sensitive data in these file types and I would like to be able to prevent accidently sending of these file types.

Very Much appreciated if anyone can point me in the right direction

[gmayor]

You could use the Outlook send event to check the attachments e.g. Save the following in the ThisOutlookSession module.
See also http://www.gmayor.com/create_and_employ_a_digital_cert.htm (http://www.gmayor.com/create_and_employ_a_digital_cert.htm) which may be required.


Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim iAtt As Integer
Dim strMsg As String
If Item.Attachments.Count > 0 Then
For iAtt = 1 To Item.Attachments.Count
If Right(UCase(Item.Attachments(iAtt).fileName), 4) = "XLSM" Then
strMsg = "You are about to send an 'xlsm' format file. Are you sure?"
If MsgBox(strMsg, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check Attachments") = vbNo Then
Cancel = True
End If
End If
Next iAtt
End If
lbl_Exit:
Exit Sub
End Sub

[rolandofeld]

thankyou so much! this works great

if I wanted to add a second dialog box?

for example: You are about to send an 'xlsm' format file. Are you sure?" if click yes then another dialog box with more text saying: are you REALLY sure?

I know this may seem silly but im trying to make it as idiot proof as possible

thanks again for your help - VERY much appreciated

[gmayor]

If you want it idiot proof, use the macro to remove the attachment.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim iAtt As Integer
Dim strMsg As String
If Item.Attachments.Count > 0 Then
For iAtt = 1 To Item.Attachments.Count
If Right(UCase(Item.Attachments(iAtt).fileName), 4) = "XLSM" Then
strMsg = "You may not send 'xlsm' format files." & "The attachment has been removed."
MsgBox strMsg, vbCritical + vbMsgBoxSetForeground, "Blocked Attachments"
Item.Attachments.Remove iAtt
Cancel = True
Exit For
End If
Next iAtt
End If
lbl_Exit:
Exit Sub
End Sub

[rolandofeld]

EXCELLENT!!

thank you soo much