Apologies, I modified an existing macro to enable it to do what you wanted, but named the path wrongly so the process would error out and quit. Use the following instead which corrects that error (and I have tested it) and also names the message as the (cleaned) subject.

Private Sub SaveAttachments(olItem As MailItem)
'Graham Mayor - http://www.gmayor.com - Last updated - 10 Aug 2018
Dim olAttach As Attachment
Dim strFname As String
Dim strExt As String
Dim j As Long
Dim strSaveFldr As String

    On Error GoTo lbl_Exit
    strSaveFldr = Environ("USERPROFILE") & "\Documents\Attachments\"
    CreateFolders strSaveFldr
    If olItem.Attachments.Count > 0 Then
        For j = 1 To olItem.Attachments.Count
            Set olAttach = olItem.Attachments(j)
            If olAttach.fileName Like "mavrpt*.*" Then
                strFname = CleanFileName(olItem.Subject) & ".xls"
                strExt = Right(strFname, Len(strFname) - InStrRev(strFname, Chr(46)))
                olAttach.SaveAsFile strSaveFldr & strFname
            End If
        Next j
        olItem.Save
    End If
lbl_Exit:
    Set olAttach = Nothing
    Set olItem = Nothing
    Exit Sub
End Sub

Private Function CleanFileName(strFileName As String) As String
Dim arrInvalid() As String
Dim lng_Index As Long
    'Define illegal characters (by ASCII CharNum)
    arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|")
    'Remove any illegal filename characters
    CleanFileName = strFileName
    For lng_Index = 0 To UBound(arrInvalid)
        CleanFileName = Replace(CleanFileName, Chr(arrInvalid(lng_Index)), Chr(95))
    Next lng_Index
lbl_Exit:
    Exit Function
End Function