Option Explicit

Sub ProcessSelectedMessage()
Dim olMsg As MailItem
    On Error GoTo lbl_Exit
    Set olMsg = ActiveExplorer.Selection.Item(1)
    SaveAttachments olMsg
lbl_Exit:
    Exit Sub
End Sub

Sub SaveAttachments(Item As Outlook.MailItem)
Dim olAtt As Attachment
Dim strFileName As String
Const strPath As String = "C:\Path\"        'The path where the files are to be saved
    If Item.Attachments.Count > 0 Then
        For Each olAtt In Item.Attachments
            If Not olAtt.FileName Like "image*.*" Then
                strFileName = strPath & olAtt.FileName
                olAtt.SaveAsFile strFileName
            End If
        Next olAtt
    End If
lbl_Exit:
    Exit Sub
End Sub