ник: k@s
Подскажите что нужно сделать чтобы все это заработало.
Function Сохранить_вложения_непрочитаное()
Dim OL_App As Outlook.Application
Dim OL_NameSpace As Outlook.NameSpace
Dim OL_FolderMail As Outlook.MAPIFolder
Dim OL_ItemMail As Outlook.MailItem
Dim OL_Attachment As Outlook.Attachment
Dim RDO_FolderMail As Object
' получаем объект Outlook
Set OL_App = CreateObject("Outlook.Application")
' получаем Namespace
Set OL_NameSpace = OL_App.GetNamespace("MAPI")
'получаем почту
OL_NameSpace.SyncObjects.Item(1).Start
' получаем ссылку на папку Входящие
Set OL_FolderMail = OL_NameSpace.GetDefaultFolder(olFolderInbox)
' разрешаем доступ к адресной книге
Set RDO_FolderMail = CreateObject("Redemption.SafeMailItem")
' перебираем все письма в папке Входящие
For Each OL_ItemMail In OL_FolderMail.Items
Set RDO_FolderMail.Item = OL_ItemMail
With RDO_FolderMail
' смотрим есть ли непрочитаные
If .UnRead = True Then
' смотрим есть ли вложения
If .Attachments.Count > 0 Then
' выводим тему, дату и время получения, имя и адрес отправителя, имя файла вложения
Debug.Print "Teмa: " & .Subject
Debug.Print "Получено: " & .ReceivedTime
Debug.Print "Имя и адрес отправителя: " & .SenderName & " (" & .SenderEmailAddress & ")"
Debug.Print "Вложения: "
For Each OL_Attachment In .Attachments
' сохраняем вложение. По адресату, вложению и т. д. можно выбрать куда
OL_Attachment.SaveAsFile "D:\Почта\" & OL_Attachment.DisplayName
Debug.Print OL_Attachment.FileName
Next
End If
' ставим отметку прочитаное.
.UnRead = False
End If
End With
Next
'В рабочем варианте все debug убрать
End Function