|
|
|
| Подскажите что нужно сделать чтобы все это заработало.
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 | |
|
| |
|
|
|
| А что не работает? Как не работает? какие сообщения выдает ? | |
|
| |
|
|
|
| выдает ошибку compile error .expected end sub.Как правильно запустить на выполнение функцию,Вот такие вопросы возникли из за проблем подключения по протоколу SSL и приходиться делать прием почты через oulook.Может есть и другие варианты но я пока альтернативы не нашел. | |
|
| |
|
|
|
| Ругается на Set RDO_FolderMail = CreateObject("Redemption.SafeMailItem") | |
|
| |
|
|
|
| выдает ошибку compile error .expected end sub. |
нужно добавить в конце процедуры end sub.
вообще странно, у вас function, а ругается на end sub.... видимо это в другом месте.
Ругается на Set RDO_FolderMail = CreateObject("Redemption.SafeMailItem")
|
какое сообщение об ошибке? | |
|
| |
|
|
|
| Через Rdo не получается сделал как " в вложенном файле" см.ниже.Но там не получается когда в базу загрузится из outlooka нужно автоматом удалить или переместить в другую папку эти файлы и загружать следующие. Прикрепленные файлы с одинаковым именем. | |
|
| |