Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.77/22: Рейтинг темы: голосов - 22, средняя оценка - 4.77
0 / 0 / 0
Регистрация: 28.12.2013
Сообщений: 9
1

Макрос для массовой распечатки вложений Outlook

28.12.2013, 18:45. Показов 4429. Ответов 10
Метки нет (Все метки)

Всем привет,

Я когда-то учил Java и PHP, так что могу понять логику несложного скрипта, но тут мне нужна ваша помощь ребята.

И так начнем. Предположим мне за день приходит 300 емайлов с темой "payslip" от "payroll" и во всех pdf файл "payslip.pdf".

Есть правило помещать такие емайлы в папку "Payslips AutoPrint", так же есть папка "PrintedPayslips".

Все 300 вложений нужно распечатать (сами емайлы печатать не нужно).

В интернете был найден данный макрос:


Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Public Sub PrintAttachments()
    Dim Inbox As MAPIFolder
    Dim Item As MailItem
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
 
    Set Inbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders.Item("Payslips AutoPrint")
 
    For Each Item In Inbox.Items
        For Each Atmt In Item.Attachments
            FileName = "C:\TempPaySlips\" & Atmt.FileName
            Atmt.SaveAsFile FileName
            Shell """C:\Program Files\Adobe\Reader 8.0\Reader\acrord32.exe"" /h /p """ + FileName + """", vbHide
        Next
        
        Item.Move PrintedPayslips
 
    Next
 
    Set Inbox = Nothing
End Sub
Все бы хорошо, но он не работает по простой причине, что все мои вложения имеют одинаковое имя "payslip.pdf"

Кто может помочь адаптировать это под мою ситуацию?!
В идеале к сохроняемому вложению в C:\TempPaySlips\ добавить прификс типа "001-Payslip.pdf ... XXX-Payslip.pdf" и проверку на уже сохраненные файлы (что если 001 - 139 заняты, то следущей сохраниться под 140-Payslip.pdf)

Так-же после того как макрос сохранил все вложения и послал их на печать - удалить все файлы из C:\TempPaySlips\

Любая помощь приветствуется!
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
28.12.2013, 18:45
Ответы с готовыми решениями:

Макрос Microsoft Outlook 2010: копирование вложений по имени вложения
Добрий день! Помогите написать макрос для Microsoft Outlook 2010, которий будет копиравать...

Макрос для Outlook
Привет всем!!! Помогите, пожалуйста. Нужен макрос или какой-то скрипт. Есть несколько магазинов....

Обработка вложений Outlook
Всем доброго времени суток! Имеется следующая задача: С определенной периодичностью на...

Получение вложений в outlook
Добрый день. Пытаюсь создать скрипт для вставки в правило с целью получения вложенных файлов в...

__________________
10
11200 / 3571 / 636
Регистрация: 13.02.2009
Сообщений: 10,671
29.12.2013, 01:59 2
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Dim FL, Num, MAX, T
MAX = 0
 
 FL = Dir("C:\TempPaySlips\*.pdf")
 
Do While FL <> ""
T = Val(Split(FL, "_")(0))
If MAX < T Then MAX = T
 FL = Dir
Loop
Num = MAX
 
 
    For Each Item In Inbox.Items
        For Each Atmt In Item.Attachments
            Num = Num + 1
            FileName = "C:\TempPaySlips\" & Format(Num, "000") & "_" & Atmt.FileName
            Atmt.SaveAsFile FileName
            Shell """C:\Program Files\Adobe\Reader 8.0\Reader\acrord32.exe"" /h /p """ + FileName + """", vbHide
        Next
 
        Item.Move PrintedPayslips
 
    Next
    
 
FL = Dir("C:\TempPaySlips\*.pdf")
Do While FL <> ""
Kill "C:\TempPaySlips\" & FL
 FL = Dir
Loop
Добавлено через 1 минуту
В твоём коде после 8 строки вставь блок
1
0 / 0 / 0
Регистрация: 28.12.2013
Сообщений: 9
06.01.2014, 17:32  [ТС] 3
Спасибо Alex,

На данный момент код выглядит так:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Public Sub PrintAttachments()
    Dim Inbox As MAPIFolder
    Dim Item As MailItem
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Dim FL, Num, MAX, T
    MAX = 0
 
    Set Inbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders.Item("Payslips AutoPrint")
 
    FL = Dir("\\fs001\users$\kafanasjev\My Documents\TempPaySlips\*.pdf")
 
    Do While FL <> ""
    T = Val(Split(FL, "_")(0))
    If MAX < T Then MAX = T
    FL = Dir
    Loop
    Num = MAX
 
 
    For Each Item In Inbox.Items
        For Each Atmt In Item.Attachments
            Num = Num + 1
            FileName = "\\fs001\users$\kafanasjev\My Documents\TempPaySlips\" & Format(Num, "000") & "_" & Atmt.FileName
            Atmt.SaveAsFile FileName
            Shell """C:\Program Files\Adobe\Reader 8.0\Reader\acrord32.exe"" /h /p """ + FileName + """", vbHide
        Next
 
        Item.Delete
 
    Next
    
    Set Inbox = Nothing
    
End Sub
Оно работает, но не доделывает до конца, оставляя один емайл и файл не распечатанным. Что изменить?

Добавлено через 1 час 13 минут
Убрал Item.Delete - печатает все теперь, но хотелось бы чтоб емайлы удалялись после печати.

Если стоит Item.Move PrintedPayslips то выдает "Run-time error '424': Object Required

Если оставить цикл на удаление файлов из My Documents\TempPaySlips\, то печатает только один файл, затем выдает, что невозможно открыть файл на распечатку, и My Documents\TempPaySlips\ пустая. Подозреваю что проблема в том, что удаляет быстрее чем печатает и решить это программно не получится.
0
11200 / 3571 / 636
Регистрация: 13.02.2009
Сообщений: 10,671
06.01.2014, 18:57 4
Удаляй в начале процедуры все файлы из папки "\\fs001\users$\kafanasjev\My Documents\TempPaySlips"

Добавлено через 4 минуты
И они там будут до следующего запуска процедуры
0
0 / 0 / 0
Регистрация: 28.12.2013
Сообщений: 9
06.01.2014, 19:27  [ТС] 5
С удалением файлов их папки ладно, разберемся... А вот почему если ставлю строку на удаление емайла после распечатки, то печатает 2 за раз и дальше не хочет?!
0
11200 / 3571 / 636
Регистрация: 13.02.2009
Сообщений: 10,671
06.01.2014, 20:10 6
Ну, наверное, из-за разницы скорости печати и скорости работы программы.
В очередь печати занесли, а файл удалили.
Попробуй удалять перед началом процедуры
0
0 / 0 / 0
Регистрация: 28.12.2013
Сообщений: 9
06.01.2014, 20:19  [ТС] 7
Alex, я наверное не правильно изъясняюсь.

Когда добавляю строку Item.Delete (как в моем примере выше), которая должна отправить емэйл в корзину после сохранения, то макрос не доделывает работу до конца.

Например: 4 емэйла в папке Payslips AutoPrint -> запускаю макрос -> сохраняются только два pdf, удаляются только 2 емэйла и печатаются только два pdf. Оставшиеся два как были в Payslips AutoPrint, так там и остались. Почему?
Если два емэйла в папке, то сохраняется, печатается и удаляется только 1. Что-то замыкает цикл на пол дороге, понять бы что.
0
11200 / 3571 / 636
Регистрация: 13.02.2009
Сообщений: 10,671
06.01.2014, 20:46 8
Может быть так работает счётчик?
Работаешь с первым итемом, распечатал и удалил.
Цикл берёт следующий итем.
Но при удалении первого итема второй становится первым и поэтому пропускается а обрабатывается третий, который после удаления стал вторым. Обычно при удалении обрабатываются с конца списка, что бы не сбивался счётчик
0
0 / 0 / 0
Регистрация: 28.12.2013
Сообщений: 9
06.01.2014, 20:51  [ТС] 9
Допустим так, есть варианты решить это? Или допустим заставить после распечатки хотя бы помещать емэйлы в PrintedPayslips, но как я написал выше выдает ошибку. Что тут не так?
0
11200 / 3571 / 636
Регистрация: 13.02.2009
Сообщений: 10,671
06.01.2014, 23:21 10
А вариант просто не трогать до следующего сеанса не подходит?
Чистить папку в начале сеанса?
Ну или надо смотреть есть ли возможность обращения по индексу к итему и начинать с максимального с шагом -1

Добавлено через 7 минут
Или ещё один цикл: в первом рапечатка, во втором удаление
0
0 / 0 / 0
Регистрация: 28.12.2013
Сообщений: 9
08.01.2014, 20:45  [ТС] 11
Alex спасибо за всю помощь, решил вставкой вот этого куска после 32ой строки в моем последнем примере:

Visual Basic
1
2
3
4
5
6
7
8
9
10
Dim EmailCount As Integer
 
EmailCount = Inbox.Items.Count
 
Do While EmailCount > 0
For Each Item In Inbox.Items
        Item.Delete
        EmailCount = EmailCount - 1
Next
Loop
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
08.01.2014, 20:45

Заказываю контрольные, курсовые, дипломные работы и диссертации здесь.

Макрос для Outlook 2016
Здравствуйте, записал макрос для Outlook 2016 Sub C11() ' ' C11 Макрос ' ' ...

Нужен макрос для Outlook
Здравствуйте! Помогите разобраться. C vba работаю первый раз, нужен макрос для Outlook, чтобы он...

Скрипт на сохранение вложений outlook
Добрый день, друзья! нужна помощь! нужен vbs скрипт, который будет в оутлуке искать письма от...

Outlook. Автоматическое сохранение вложений
Для автоматического сохранения вложений при приеме новых писем у меня поставлен следующий макрос: ...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
11
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.