raylward102
09-25-2019, 12:20 PM
I've successfully configured outlook to block certain file attachments, via windows registry.
I've successfully created an outlook vba subroutine, allowing the user to one click save all attachments, from the email in focus, to a pre-specified folder on the desktop.
I know how to unblock blocked attachments via registry, followed by rebooting outlook.
What I would like to do, is make vba, work for blocked attachments. Obviously, the blocked attachments are still stored in the outlook store; I'm unaware of how to address blocked attachments without modifying the registry (unblocking and restarting outlook).
I want the user to see the attachments are blocked (unsafe) and to use my one click save method (outlook vba), which will store these blocked attachments to a specified folder, where the user can easily, right click on the files, choosing to open 'sand boxed'. For those who don't know what sand boxing is, it's an application (like sandboxie), allowing the user to safely open-execute, potentially unsafe applications and their documents, in a closed environment, that will not allow your system to be infected.
Permanently blocking unsafe attachments from my users, isn't the answer; there will always need to look and see the content of these files and figured would be easiest to make user aware by blocking, triggering the user to open in the non traditional method, via sandbox, rather than double clicking the attachment, having it potentially unleashing malware.
Currently, my code does not see blocked attachments.
Public Sub saveAttachtoDisk()
Dim objAtt As Outlook.Attachment
Dim olMsg As Outlook.MailItem
Dim strDate As String
Dim strName As String
Dim saveFolder As String
Dim saveSubFolder As String
Dim x As Long
saveFolder = Environ("userprofile") & "\desktop\BlockedAttachments\"
Err.Clear
On Error Resume Next
'detect folder
x = GetAttr(saveFolder)
If Err.Number <> 0 Then
MkDir saveFolder
Err.Clear
End If
saveSubFolder = saveFolder & Month(Date) & "-" & Day(Date) & "-" & Year(Date) & "\"
'detect folder
x = GetAttr(saveSubFolder)
If Err.Number <> 0 Then
MkDir saveSubFolder
Err.Clear
End If
Set olMsg = ActiveExplorer.Selection.Item(1)
For Each objAtt In olMsg.Attachments
objAtt.SaveAsFile saveSubFolder & objAtt.FileName
Next objAtt
lbl_Exit:
Set objAtt = Nothing
Set olMsg = Nothing
Exit Sub
End Sub
I've successfully created an outlook vba subroutine, allowing the user to one click save all attachments, from the email in focus, to a pre-specified folder on the desktop.
I know how to unblock blocked attachments via registry, followed by rebooting outlook.
What I would like to do, is make vba, work for blocked attachments. Obviously, the blocked attachments are still stored in the outlook store; I'm unaware of how to address blocked attachments without modifying the registry (unblocking and restarting outlook).
I want the user to see the attachments are blocked (unsafe) and to use my one click save method (outlook vba), which will store these blocked attachments to a specified folder, where the user can easily, right click on the files, choosing to open 'sand boxed'. For those who don't know what sand boxing is, it's an application (like sandboxie), allowing the user to safely open-execute, potentially unsafe applications and their documents, in a closed environment, that will not allow your system to be infected.
Permanently blocking unsafe attachments from my users, isn't the answer; there will always need to look and see the content of these files and figured would be easiest to make user aware by blocking, triggering the user to open in the non traditional method, via sandbox, rather than double clicking the attachment, having it potentially unleashing malware.
Currently, my code does not see blocked attachments.
Public Sub saveAttachtoDisk()
Dim objAtt As Outlook.Attachment
Dim olMsg As Outlook.MailItem
Dim strDate As String
Dim strName As String
Dim saveFolder As String
Dim saveSubFolder As String
Dim x As Long
saveFolder = Environ("userprofile") & "\desktop\BlockedAttachments\"
Err.Clear
On Error Resume Next
'detect folder
x = GetAttr(saveFolder)
If Err.Number <> 0 Then
MkDir saveFolder
Err.Clear
End If
saveSubFolder = saveFolder & Month(Date) & "-" & Day(Date) & "-" & Year(Date) & "\"
'detect folder
x = GetAttr(saveSubFolder)
If Err.Number <> 0 Then
MkDir saveSubFolder
Err.Clear
End If
Set olMsg = ActiveExplorer.Selection.Item(1)
For Each objAtt In olMsg.Attachments
objAtt.SaveAsFile saveSubFolder & objAtt.FileName
Next objAtt
lbl_Exit:
Set objAtt = Nothing
Set olMsg = Nothing
Exit Sub
End Sub