Сохранить все вложения в указанную директорию

' Следующий VB-скрипт для Microsoft Outlook сохраняет все вложения всех сообщений в выбранной папке в 
' директорию c:\\data2\\ .
' Посетите мой веб-сайт по SPSS: http://www.spsstools.ru

Public Sub SaveAttachments()
    ' Сохранить все приложения всех сообщений в выбранной папке в c:\\data2\\
    ' Размещено в новостной группе spss 07.01.2003, автор: Raynald Levesque
    Dim mynamespace As NameSpace
    Dim email As MailItem
    Dim atAttachs As Attachments
    Dim atAttach As Attachment
    Dim myfolder As MAPIFolder
    Dim myitem As MailItem
    Dim strPath As String
    Dim intCnt As Integer
    Dim intEmails As Integer

    strPath = "c:\\data2\\"
    Set mynamespace = Application.GetNamespace("MAPI")

    Set myfolder = mynamespace.PickFolder
    'Set myfolder = mynamespace.GetDefaultFolder(olFolderInbox)
    myfolder.Display

    ' Пробегаемся по всем сообщениям в папке
    For intEmails = 1 To myfolder.Items.Count
        Set myitem = myfolder.Items(intEmails)
        'myitem.Display
        Debug.Print "число вложений= " & myitem.Attachments.Count
        Set atAttachs = myitem.Attachments
        For intCnt = 1 To myitem.Attachments.Count
            'Пробегаемся по всем вложениям
            Set atAttach = atAttachs(intCnt)
            atAttach.SaveAsFile (strPath & atAttach.FileName)
        Next
    Next intEmails

End Sub