How can you have reserved characters in the filenames?

The following will copy accessible linked files to the folder on your desktop, with the original filenames. If the name already exists in the target folder it will be overwritten. If you want to retain existing files then see the filenameunique code example on my web site. The target folder is created if it doesn't exist. Select a message and Run the Test macro. Alternatively you could run the main macro as a script from a rule that identifies the messages in question as they arrive.

Option Explicit

Sub Test()
Dim olMsg As MailItem
    'On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    SaveLinkedFiles olMsg
lbl_Exit:
    Exit Sub
End Sub

Sub SaveLinkedFiles(olItem As Object)
'Graham Mayor - http://www.gmayor.com - Last updated - 18 Jun 2018
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oLink As Object
Dim strSource As String
Dim strFname As String
Dim fso As Object
    CreateFolders Environ("USERPROFILE") & "\Desktop\Outlook Hyperlinks"
    Set fso = CreateObject("Scripting.FileSystemObject")
    If TypeName(olItem) = "MailItem" Then
        With olItem
            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            .Display
            For Each oLink In wdDoc.Hyperlinks
                strSource = oLink.Address
                If fso.FileExists(strSource) Then
                    strFname = Mid(strSource, InStrRev(strSource, Chr(92)))
                    FileCopy oLink.Address, Environ("USERPROFILE") & "\Desktop\Outlook Hyperlinks" & strFname
                End If
            Next oLink
        End With
    End If
    olItem.Close 0
lbl_Exit:
    Set olInsp = Nothing
    Set fso = Nothing
    Set wdDoc = Nothing
    Set oLink = Nothing
    Exit Sub
End Sub

Public Sub CreateFolders(strPath As String)
'A Graham Mayor/Greg Maxey AddIn Utility Macro
Dim oFSO As Object
Dim lng_PathSep As Long
Dim lng_PS As Long
    If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
    lng_PathSep = InStr(3, strPath, "\")
    If lng_PathSep = 0 Then GoTo lbl_Exit
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Do
        lng_PS = lng_PathSep
        lng_PathSep = InStr(lng_PS + 1, strPath, "\")
        If lng_PathSep = 0 Then Exit Do
        If Len(Dir(Left(strPath, lng_PathSep), vbDirectory)) = 0 Then Exit Do
    Loop
    Do Until lng_PathSep = 0
        If Not oFSO.FolderExists(Left(strPath, lng_PathSep)) Then
            oFSO.CreateFolder Left(strPath, lng_PathSep)
        End If
        lng_PS = lng_PathSep
        lng_PathSep = InStr(lng_PS + 1, strPath, "\")
    Loop
lbl_Exit:
    Set oFSO = Nothing
    Exit Sub
End Sub