Outook 2010 VBA macro to remove string patterns from filenames of attachments.

RemovePatternFromAttachmentFilename

Sub RemovePatternFromAttachmentFilename()

    Dim strPattern As String: strPattern = "^[0-9]{3,12}[_][0-9]{1,3}[ ]" ' Matches e.g. "123456_2 Example file.docx"
    Dim strReplace As String: strReplace = ""
    Dim regEx As New RegExp ' RegExp needs to be enabled. http://stackoverflow.com/questions/21139938/vba-regexp-causes-compile-error-while-vbscript-regexp-works
    regEx.Pattern = strPattern

    Dim message As Outlook.MailItem
    Dim attac As Attachment
    Dim i As Long

    strTmpFolder = IIf(Environ$("tmp") <> "", Environ$("tmp"), Environ$("temp")) & "\"
    Set message = ThisOutlookSession.ActiveInspector.CurrentItem

    For i = 1 To message.Attachments.Count
        Set attac = message.Attachments(i)
        If regEx.Test(attac.FileName) Then
            strippedFileName = strTmpFolder & regEx.Replace(attac.FileName, strReplace)
            attac.SaveAsFile (strippedFileName) ' saves with new name
            attac.Delete ' removes original attachment from email
            i = i - 1
            message.Attachments.Add (strippedFileName) ' reattachs attachment with new name
            Kill strippedFileName ' Deletes the renamed attachemnt from the temp folder
        End If
    Next i
End Sub