' The following sub-routine is called by the Outlook Rule to filter incoming email
Sub ConvertDefangedToOriginalName(MyMail As MailItem)
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim fso, f
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.OpenTextFile("c:\AttachmentFilter.txt", ForAppending, True)
    
    Set myattachments = MyMail.Attachments
        
    If myattachments.Count > 0 Then
        attach_count = myattachments.Count
        
        ' Iterate over attachments
        For attach_num = 1 To attach_count
            Set myattachment = myattachments.Item(attach_num)
        
            ' Is it DEFANGED?
            If myattachment.Type <> olByValue Then
                ' Do nothing - Might be olOLE or some other weird type
            ElseIf InStr(1, myattachment.FileName, "DEFANGED", 1) Then
                ' Searching backwards look for '-' before the extension
                For i = Len(myattachment.FileName) To 1 Step -1
                    If Mid(myattachment.FileName, i, 1) = "-" Then
                        ' Calculate the extension name
                        ext = Mid(myattachment.FileName, i + 1, Len(myattachment.FileName) - i)
                    
                        FName = ""
                        ' Search for end of DEFANGED addition (the first period from the right)
                        For j = i - 1 To 1 Step -1
                            If Mid(myattachment.FileName, j, 1) = "." Then
                                FName = Mid(myattachment.FileName, 1, j) + ext
                                Exit For
                            End If
                        Next
                        
                        ' If we don't have a file name but only an extension then something's probably wrong. Do nothing...
                        If (FName <> "") Then
                            ' Temporary storage for the attachment. Change c:\temp\attach as you see fit. Requires trailing \
                            save_path = "c:\temp\attach\" + FName
                            
                            DryRun = False
                            
                            ' Save the attachment to the file
                            If (DryRun <> True) Then
                                Call myattachment.SaveAsFile(save_path)
                            End If
                            
                            ' Save info about the attachment
                            attach_type = myattachment.Type
                            attach_index = myattachment.Index
                            attach_filename = myattachment.FileName
                            
                            f.writeline "Reattaching " + FName
                            ' Add the attachment under the pretty name
                            If (DryRun <> True) Then
                                Call myattachments.Add(save_path, attach_type, 1, FName)
                            End If
                            
                            f.writeline "Deleting attachment " + attach_filename
                            ' Remove the old attachment - Remove after add as per MS manual suggestion
                            If (DryRun <> True) Then
                                Call myattachments.Remove(attach_index)
                            End If
                            
                            f.writeline "Saving message"
                            ' Sync the mail message
                            If (DryRun <> True) Then
                                MyMail.Save
                            End If

                            ' Erase the temporary file with the attachment content from the file system
                            f.writeline "Removing file " + save_path
                            If (DryRun <> True) Then
                                Set fso_temp = CreateObject("Scripting.FileSystemObject")
                                Set fh = fso_temp.GetFile(save_path)
                                fh.Delete
                                Set fso_temp = Nothing
                            End If
                            
                            f.writeline ""
                                                        
                            'f.writeline attach_filename + " ==> " + save_path
                            ' Warning! Changing loop control variable. Because we don't control the order in the map
                            ' we need to do a full pass again after changing it. Shame on me for writing such code.
                            If (DryRun <> True) Then
                                attach_num = 0
                            End If
                            ' Exit for as we found our full file name and finished renaming
                            Exit For
                        End If
                    End If
                Next
            End If
        Next
    End If
    f.Close
    Set fso = Nothing
End Sub