fetching blocked attachments

[raylward102]

I have adjusted windows registry to block certain attachments (xls, doc, xlsm, docm), so users won't accidentally, on auto pilot, execute an attachment, potentially harboring a malware. For those who are unaware, files carrying those extensions, can contain macro vba code. In my opinion, there's no reason to be using those formats via email.
With the registry block in place, the user sees the email has an attachment, but the contents of the message, prohibits user from accessing the attachment; instead a message is presented stating the attachment has been blocked.
This approach to blocking is effective, but, would like to be able to download these attachments to a folder. I had hoped to create a vba add-in, allowing user to see the blocking occur, but still allow them to download safely with my add-in; my add-in would save these attachments to a folder on the desktop, and open them via 'sandboxie' application; the 'sandboxie' application, basically allows you to open suspect, quarantined items, in a closed environment, that is scrapped as soon as you close the window; preventing any changes to the computer. I want to do this because, the users still have a need for viewing the content of these potentially harmful attachments, as some of them will be legitimate.
I realize, the windows registry is configured to block these attachments via the outlook user interface, but know the attachments are still physically present, in the outlook mail store (unblocking via windows registry returns access to these attachments).

The following code, downloads the attachments from the email message in focus; can anybody think of away to alter my code, so it can see blocked attachments. Currently, with blocking enabled, it does not see the 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