Sub CustomSaveAttachments(Item As Outlook.MailItem)
Dim olAtt As Attachment
Dim strFileName As String
Const strPath As String = "C:\Path\"    ' The location where the attachment is to be saved
Const strExt As String = "xlsx"    ' the filename extension
    If Item.Attachments.Count > 0 Then
        For Each olAtt In Item.Attachments
            'Check the attachment file type by looking at the extension
            If olAtt.FileName Like "*" & strExt Then
                strFileName = Format(Date, "yyyymmdd-") & "(" & Format(Time, "HHMM) - ") & olAtt.FileName
                olAtt.SaveAsFile strPath & strFileName
            End If
        Next olAtt
    End If
lbl_Exit:
    Set olAtt = Nothing
    Exit Sub
End Sub

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