Благодаря этому форуму мне получилось наладить документооборот в Excel (точнее регистрацию входящих-исходящих писем) в более-менее автоматизированном виде. В приложенном файле следующие основные макросы: 1. "Первое_MailSave" - прописывает письма из папки входящие Outlook 2. "Второе_в_шаблон" - выдает входящий номер и выводит данные в определенный шаблон (одобренный руководством в плане удобочитаемости) 3. "Завершение_Печать" - сохраняет лист шаблона в формате pdf в папке с входящим номером и пускает на печать. Т.е. счастье есть, теперь полная обработка 10 писем занимает 3-4 минуты, а не 30-40.
Проблема с обработкой вложений: 1. Как не в ручную прописывать кол-во вложений в письме, а автоматом с выводом в ячейку E4 листа "data" количества + 1 (само письмо) 2. Как в листе "Шаблон" в В5 перечислить все вложения по именам 3. Что добавить в макрос "Завершение_Печать", чтобы вложения сохранялись в новосозданную папку с самим письмом.
Все данные из письма забираются, а вот с вложением так и не придумал как(см.код)
Код
Sub Первое_MailSave()
Application.EnableEvents = False
Dim oOutlook As New Outlook.Application
Dim oNamespace As Outlook.Namespace
Dim myFolder As Outlook.Folder
Dim myMail As Outlook.Items
Dim myItem As Outlook.MailItem
Dim r
Set oNamespace = oOutlook.GetNamespace("MAPI")
'папка в Outlook, откуда сохраняем письма
Set myFolder = oNamespace.GetDefaultFolder(olFolderInbox) 'если письма нужны из вложенной папки, то записывается в следующем виде:
'.Folders("webley").Folders("test")
Set myMail = myFolder.Items
Cells.Clear
Cells(3, 2) = "От кого"
'Cells(1, 2) = "E-mail"
'Cells(1, 3) = "Кому"
Cells(3, 3) = "Тема"
Cells(3, 1) = "Дата"
Cells(3, 4) = "Тело письма"
Cells(3, 5) = "Кол-во страниц"
r = 4
For Each myItem In myMail
On Error Resume Next
Cells(r, 2) = myItem.SenderName
' Cells(r, 2) = myItem.SenderEmailAddress
' Cells(r, 3) = myItem.To
Cells(r, 3) = myItem.Subject
Cells(r, 1) = myItem.CreationTime
Cells(r, 4) = myItem.Body
On Error GoTo 0
r = r + 1
Next
Application.EnableEvents = True 'отключаем обработку события
End Sub
Поиски в интернете все ссылаются на макросы для outlook, но регистрация и создание необходимых директорий у меня происходит в excel, соответственно все переменные в нем же. С одной стороны, у меня три разных вопроса, но, мне кажется, что оптимальнее будет реализовать все три вопроса в одном макросе.
destinationFolder = "C:\Папка для вложений"
Количество = 0
ПоИменам = ""
For Each myItem In myMail
On Error Resume Next
''<<<<<<<<<<<<<<< 3 в одном >>>>>>>>>>>>>>
Set colAttachments = myItem.Attachments
Количество = colAttachments.Count
For Each objAttachment In colAttachments
objAttachment.SaveAsFile (destinationFolder & "/" & objAttachment.FileName)
ПоИменам = ПоИменам & objAttachment.FileName & ";"
Next
''<<<<<<<<<<<<<<<>>>>>>>>>>>>>>
Cells(r, 2) = myItem.SenderName
' Cells(r, 2) = myItem.SenderEmailAddress
' Cells(r, 3) = myItem.To
Cells(r, 3) = myItem.Subject
Cells(r, 1) = myItem.CreationTime
Cells(r, 4) = myItem.Body
On Error GoTo 0
r = r + 1
Next
Спасибо то что надо. Сейчас играюсь с папками назначения вложений для каждого письма пока что так
Код
Sub Первое_MailSave()
Application.EnableEvents = False
Dim oOutlook As New Outlook.Application
Dim oNamespace As Outlook.Namespace
Dim myFolder As Outlook.Folder
Dim myMail As Outlook.Items
Dim myItem As Outlook.MailItem
Dim r
Set oNamespace = oOutlook.GetNamespace("MAPI")
'папка в Outlook, откуда сохраняем письма
Set myFolder = oNamespace.GetDefaultFolder(olFolderInbox) 'если письма нужны из вложенной папки, то записывается в следующем виде:
'.Folders("webley").Folders("test")
Set myMail = myFolder.Items
destinationFolder = "E:\temp\test\Att\"
Количество = 0
ПоИменам = ""
Cells.Clear
Cells(3, 2) = "От кого"
'Cells(1, 2) = "E-mail"
'Cells(1, 3) = "Кому"
Cells(3, 3) = "Тема"
Cells(3, 1) = "Дата"
Cells(3, 4) = "Содержание"
Cells(3, 5) = "Кол-во страниц"
Cells(3, 6) = "Вложения"
r = 4
For Each myItem In myMail
On Error Resume Next
''<<<<<<<<<<<<<<< 3 в одном >>>>>>>>>>>>>>
Set colAttachments = myItem.Attachments
Количество = colAttachments.Count + 1
For Each objAttachment In colAttachments
MkDir (destinationFolder & myItem.SenderName)
destinationFolder1 = (destinationFolder & myItem.SenderName)
objAttachment.SaveAsFile (destinationFolder1 & "/" & objAttachment.Filename)
ПоИменам = ПоИменам & objAttachment.Filename & "; "
Next
''<<<<<<<<<<<<<<<>>>>>>>>>>>>>>
Cells(r, 2) = myItem.SenderName
' Cells(r, 2) = myItem.SenderEmailAddress
' Cells(r, 3) = myItem.To
Cells(r, 3) = myItem.Subject
Cells(r, 1) = myItem.CreationTime
Cells(r, 4) = myItem.Body
Cells(r, 5) = Количество
Cells(r, 6) = ПоИменам
On Error GoTo 0
r = r + 1
Next
Application.EnableEvents = True 'отключаем обработку события
End Sub
Doober, все было хорошо, пока не заметил, что в ячейке "ПоИменам" макрос стал добавлять имена всех вложений из всех писем в папке входящие. Т.е. в первом письме все ок - количество и имя вложения прописывает во втором - плюс к имени вложения добавляет имена вложений из первого письма третье и так и далее