Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Как добавить имена вложений Outlook в Excel, с последующим сохранением их в указанной папке.
 
Добрый день всем гуру Excel-я.

Благодаря этому форуму мне получилось наладить документооборот в 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, соответственно все переменные в нем же.
С одной стороны, у меня три разных вопроса, но, мне кажется, что оптимальнее будет реализовать все три вопроса в одном макросе.

С уважением, Лев
Изменено: yaararamaloke - 28 Апр 2015 00:01:05
 
Здравствуйте.
Так можно.
Код
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
Изменено: Doober - 28 Апр 2015 02:02:50
 
Спасибо то что надо.
Сейчас играюсь с папками назначения вложений  для каждого письма
пока что так
Код
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, все было хорошо, пока не заметил, что в ячейке "ПоИменам" макрос стал добавлять имена всех вложений из всех писем в папке входящие.
Т.е. в первом письме все ок - количество и имя вложения прописывает
во втором - плюс к имени вложения добавляет имена вложений из первого письма
третье и так и далее
 
 Очичайте переменную в другом месте.У меня был только пример реализации.
Код
 '  ПоИменам = ""
                 
                 
        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
  ПоИменам = ""
 
все работает как часы.
Документооборот налажен
Страницы: 1
Читают тему (гостей: 1)