Save_Attachments

[Exo]

Доброго времени суток!
из-за отсутствия специализированного раздела пишу тут.

Прошу Вашей помощи в решении следующей задачи.
Тема многократно обсасывалась в интернете, НО честно потратив несколько часов на поиски, доведенного до ума рецепта я не нашел (или работает не так, или не работает вовсе или исполнение задачи в виде платного модуля).

задача: мне необходимо, что бы Outlook при новом входящем письме сохранял вложенный в письмо файл на жестком диске ПК.
используя

.. As Outlook.MailItem

удалось упростить код до нескольких строк, т.к. с помощью этого метода макрос можно завязать через сценарии со штатными "правилами обработки почты" самого Outlook (идея найдена в интернете, источников так много, что определить автора мне не удалось, но идея отличная).

итак, проблема по большому счету в моей неграмотности относительно VBA.
Указанный макрос отлично работает, НО немножко не так как хотелось.
Макрос ниже действительно сохраняет вложение входящего письма в указанную в макросе папку, НО
имя которое присваивается сохраняемому файлу = оригинальное имя_оригинальное расширение_системная дата(макрос)_расширение файла(макрос).

как из этой цепочки убрать оригинально расширение? не очень красиво получается, например:
прайс.xls 10.02.2012.xls
Задача то по большому счету просто добавить дату перед оригинальным расширением файла.

и еще такой вопрос, жестко перечислить расширения файлов которые нужно сохранять?
дело в том, что макрос сохраняет все вложенные данные, вплоть до картинок из подписи (многие компании добавляют в подпись сотрудника логотип компании в виде картинки).

заранее спасибо тем кто откликнется.

Sub Save_Attachments(myItem As Outlook.MailItem)
Dim att_count As Integer
Dim day As Date
day = Format(Now(), "dd mmmm yyyy")
For att_count = 1 To myItem.Attachments.Count
myItem.Attachments.Item(att_count).SaveAsFile ("C:\TEST\" & myItem.Attachments.Item(att_count).DisplayName & " " & day & ".csv")
Next
End Sub

[аналитика]

Sub Save_Attachments(myItem As Outlook.MailItem)
    Dim sD As String
    sD = Format(Now(), " dd mmmm yyyy")    ' пробел впереди!

    Dim att As Attachment
    For Each att In myItem.Attachments
        Dim s As String
        s = att.Filename

        Dim pd As Integer
        pd = InStrRev(s, ".")

        Dim n As String, w As String
        n = Left(s, pd - 1)
        w = Right(s, Len(s) - pd)
        If InStr(1, "xls_doc_txt_img_", w) > 0 Then _
           att.SaveAsFile "C:\TEST\" & n & sD & "." & w
    Next att
End Sub

[Exo]

it's brilliant!!!
аналитика, большое человеческое спасибо!