Check if email attachment is password protected before sending - vba

Question

I'm trying to check all my attachments before sending an email to see if they are password protected. Typically these will be Word, Excel or PowerPoint files.
I've got as far as seeing if there are attachments.
I don't know how to loop through each attachment in the mail file to see if each one is password protected.
Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim attachments2 As Outlook.attachments
Dim attachm As Outlook.Attachment
If Item.attachments.Count > 0 Then
Set attachments2 = Item.attachments
Set attachm = Item.Attachment
For Each attachm In attachments2
' ***IM GUESSING CODE TO CHECK IF ATTACHMENTS ARE PROTECTED WOULD GO IN HERE?***
Next
End If
End Sub

Answer 1

The code below does not solve your issue, but does show how to check documents and databases to see if password protected. If you are able to obtain the file path, then this code could be modified to pass the path and filename, then return a flag to indicate PW status. Or just modify and embed this code in your module.
Revision 1: Instead of trying to find the path of the file to check for a password, an alternate solution would be for your code to save the file to a temp folder, then delete when finished. The following line of code will give you a temp folder (i.e. C:\Users\MyName\AppData\Local\Temp)
strFolder = objFSO.GetSpecialFolder(2)
This idea was obtained from a post that allows you to rename attachments: http://www.flobee.net/rename-outlook-attachments-before-you-send-them/
Also, the OP need to consider how to implement/perform the password check. If the code is called 'automatically', then unless you have some rule to only check certain files, then your code will always check ALL attachments for ALL emails! I doubt that's what you want to happen. Perhaps a user button on the tool bar?
Original Code:
Option Compare Database
Option Explicit
Public Function Check_For_Passwords()
Dim objWord As Word.Application
Dim objWordDoc As Word.Document
Dim sPath As String
Dim sFileName As String
Dim oAccess As Access.Application
On Error GoTo Error_Trap
' Set the following string to the path of your Word Document
sPath = "C:\data\WP\" ' <<< CHANGE THIS!!
sFileName = "Access.doc" ' <<< CHANGE THIS!!
Set objWord = CreateObject("Word.Application")
objWord.Visible = False
' Use a fake password - if no password on doc, OK; If password protected will fail
Set objWordDoc = objWord.Documents.Open(sPath & sFileName, , True, , "*****")
'Err: 5408 The password is incorrect. Word cannot open the document.
Set oAccess = CreateObject("Access.Application")
oAccess.Visible = False
sPath = "C:\data\Access\" ' <<< CHANGE THIS!!
sFileName = "PWD_DB.mdb" ' <<< CHANGE THIS!!
'If error, then database has password
oAccess.DBEngine.OpenDatabase sPath & sFileName, False
'Err: 3031 Not a valid password.
Exit Function
Error_Trap:
If Err.Number = 5408 Then
MsgBox "Document has a password! Do whatever... " & sPath & sFileName
ElseIf Err.Number = 3031 Then
MsgBox "Access DB has a password! Do whatever... " & sPath & sFileName
Else
MsgBox "Unexpected error: " * Err.Number & vbTab & Err.Description
End If
End Function