Save BLOCKED attachments from opened email

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.

Code:

---

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

---