Rename attachment with part of email subject

[gmayor]

Replace the first part with

Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim strSubject As String
Dim strName As String
    strSubject = "Our Ref: " & Right(itm.Subject, Len(itm.Subject) - InStrRev(itm.Subject, Chr(32)))
    saveFolder = "Y:\accounts\success fee bills\"
    For Each objAtt In itm.Attachments
        If Right(LCase(objAtt.fileName), 4) = ".xls" Then
            strName = CleanFileName(strSubject & ".xls", ".xls")
            objAtt.SaveAsFile saveFolder & strName
        End If
    Next objAtt
    Set objAtt = Nothing
End Sub