Автоматическое сохранение писем на жесткий диск/сетевую папку

@Cedo · Регистрация: 18.02.2019

Студворк — интернет-сервис помощи студентам

Здравствуйте!

Имею Outlook 2010
Суть вопроса такова - Мне необходимо отправлять ежедневные отчеты определенной группе получателей (Доменная сеть). Помимо этого, нужно сохранять копию этого письма на сетевом диске. Знаю, что можно это сделать по средствам создания скрипта. Сам в этом не разбираюсь и очень прошу помочь в этом!
Идея такова - я могу настроить правило, которое будет срабатывать при отправке определенному получателю, в котором укажу запуск скрипта, который будет копировать письмо в определенную папку на сетевом диске. В случае недоступности сетевого ресурса, необходимо, что бы он предупреждал об этом и делал повторную попытку.
Т.к. отчеты на сетевом диске нужно группировать по году и месяцу, небходимо что бы он автоматически создавал новую папку на новый месяц в формате \2019.02 (гггг.мм) Название письма это - тема письма и в конце нужно добавлять индекс (переменную)
Например мне нужно скидывать 4 письма в день. название темы у всех писем одинаковое "Осмотр помещения 15.02.2019", ежедневно будет меняться только дата. т.е в день у меня должно получится "\\Сетевой путь\2019.02\Осмотр помещения 15.02.2019(1).msg" "\\Сетевой путь\2019.02\Осмотр помещения 15.02.2019(2).msg" "\\Сетевой путь\2019.02\Осмотр помещения 15.02.2019(3).msg" "\\Сетевой путь\2019.02\Осмотр помещения 15.02.2019(4).msg"

Очень сильно прошу помочь в решении этой задачи!

@Loya · 19.02.2019, 12:11

Cedo, на вскидку:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Const network_path As String = "\\192.168.1.1\IT\" ' сетевой путь
Dim xMail As Outlook.MailItem
Set xMail = Item
Dim curr_folder As String
curr_folder = network_path & Year(Now) & "." & Month(Now) ' сетевой путь + каталог в формате "гггг.мм"
If Dir(curr_folder, vbDirectory) = "" Then ' проверяем, если такого каталога нету
    MkDir curr_folder ' то создаём его
End If
 
xMail.SaveAs curr_folder & "\" & xMail.Subject & ".msg" ' сохраняем письмо, в качестве имени используем тему письма
 
End Sub

@Cedo · 22.02.2019, 12:05 **[ТС]**

Скрипт не отображается в списке. И его не видно с списке макросов. В отладчике ругается на 6 строку network_path
Пробовал убрать Private, не помогло

Добавлено через 29 минут

Сообщение от Loya

Cedo, на вскидку:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Const network_path As String = "\\192.168.1.1\IT\" ' сетевой путь
Dim xMail As Outlook.MailItem
Set xMail = Item
Dim curr_folder As String
curr_folder = network_path & Year(Now) & "." & Month(Now) ' сетевой путь + каталог в формате "гггг.мм"
If Dir(curr_folder, vbDirectory) = "" Then ' проверяем, если такого каталога нету
    MkDir curr_folder ' то создаём его
End If
 
xMail.SaveAs curr_folder & "\" & xMail.Subject & ".msg" ' сохраняем письмо, в качестве имени используем тему письма
 
End Sub

Скрипт не отображается в списке. И его не видно с списке макросов. В отладчике ругается на 6 строку network_path
Пробовал убрать Private, не помогло

@Loya · 22.02.2019, 15:31

Добавлено через 27 секунд
Cedo, Какая версия офиса и винды? У меня офис 2007 на win10 этот код работает. Есть ли доступ к сетевой папке? В 6-ой строке переменной присваивается путь к сетевому каталогу, в моём случае это: \\192.168.1.1\IT\2019.2\
Проверьте доступ к Вашей директории. Какую именно ошибку выдаёт?

@Cedo · 22.02.2019, 15:42 **[ТС]**

Loya, Офис 2010, видна 7 про 64x. Ошибка во вложении. Путь доступен!

@Loya · 22.02.2019, 15:43

И в списке макросов он у меня тоже не отображается, но 100% работает при отправке письма.

@Loya · 22.02.2019, 15:48

А куда Вы код добавляете? Сюда? Макросы в аутлуке включены?

Автоматическое сохранение писем на жесткий диск/сетевую папку

@Cedo · 22.02.2019, 15:54 **[ТС]**

Добавляю в модуль, макросы включены

@Loya · 22.02.2019, 21:30

Ну по Вашей ошибке в гугле такая инфа:

A constant must be initialized. This error has the following causes and solutions:
You tried to initialize a constant with a variable, an instance of a user-defined type, an object, or the return value of a function call.
Initialize constants with literals, previously declared constants, or literals and constants joined by operators (except the Is logical operator).

У Вас curr_folder точно объявлена, как переменная, т.е. с модификатором Dim? Попробуйте тогда network_path объявить тоже, как переменную, а не как константу. 2010 офиса к сожалению нету, не могу попробовать с Вашими условиями использования. У меня приведённый выше код работает. К сожалению, ничем не могу больше помочь.

Может кто-то с такими же параметрами (Вин7 + Офис 2010) попробует и отпишется тут.

@Cedo · 22.02.2019, 22:04 **[ТС]**

И в списке макросов он у меня тоже не отображается, но 100% работает при отправке письма
___________
А как быть с реализацией того, что мне нужно сохранять письма только отпределенной группы получателей и как это сделать, если в правиле не запускать скрипт?

@snipe · 23.02.2019, 00:13

Сообщение от Cedo

И в списке макросов он у меня тоже не отображается, но 100% работает при отправке письма

он и не должен отображаться в списке макросов
поскольку код прописан на событие (в данном случае отправка любого сообщения)
так что надо в коде отлавливать юзера которому пойдет письмо (т.е. забудьте про правило)

@Cedo · 23.02.2019, 09:35 **[ТС]**

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub CustomMailMessageRule(Item As Outlook.MailItem)
 
    Const network_path As String = "C:\temp" ' сетевой путь
    Const MSG_FORMAT As String = "msg"
    Dim oSelection As Selection
    Dim oItem As Outlook.MailItem
    Dim curr_folder As String
    curr_folder = network_path & Year(Now) & "." & Month(Now) ' сетевой путь + каталог в формате гггг.мм"
    If Dir(curr_folder, vbDirectory) = "" Then ' проверяем, если такого каталога нет
        MkDir curr_folder ' то создаем его
    End If
    
    oItem.SaveAs curr_folder & "" & Item.Subject & "." & MSG_FORMAT ' сохраняем письмо, в качестве имени используем тему письма
 
End Sub

Немного порылся в просторах сети... примерно такое у меня получилось, НО письма не сохраняет. Скрипт в списке есть. Папку создает. А писем нет

@snipe · 23.02.2019, 10:33

после end if
вставьте строку

Visual Basic
1
msgbox curr_folder & "" & Item.Subject & "." & MSG_FORMAT

и возможно увидите ошибку
(вероятно пропущен \)

@Cedo · 23.02.2019, 13:18 **[ТС]**

Сообщение от snipe

после end if
вставьте строку
Visual BasicВыделить код
1
msgbox curr_folder & "" & Item.Subject & "." & MSG_FORMAT
и возможно увидите ошибку
(вероятно пропущен \)

Поставил \ между "" все показывает правильно и путь и имя письма. Но не сохраняет.

Сообщение от Cedo

oItem.SaveAs curr_folder & "" & Item.Subject & "." & MSG_FORMAT ' сохраняем письмо, в качестве имени используем тему письма

Может здесь что то не так?

Добавлено через 2 часа 25 минут

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub CustomMailMessageRule(Item As Outlook.MailItem)
 
    Const network_path As String = "C:\temp" ' сетевой путь
    Const MSG_FORMAT As String = "msg"
    Dim oSelection As Selection
    Dim curr_folder As String
    curr_folder = network_path & Year(Now) & "." & Month(Now) ' сетевой путь + каталог в формате гггг.мм"
    If Dir(curr_folder, vbDirectory) = "" Then ' проверяем, если такого каталога нет
        MkDir curr_folder ' то создаем его
    End If
    
    Item.SaveAs curr_folder & "\" & Item.Subject & "." & MSG_FORMAT ' сохраняем письмо, в качестве имени используем тему письма
 
End Sub

Такое ощущение, что он не понимает что именно ему нужно сохранить. Как сослаться на письмо, от которого запускается правило?

@snipe · 23.02.2019, 16:14

вы создали макрос
зачем?
вам дали код на событие - вы пишите код макроса

@Cedo · 23.02.2019, 19:11 **[ТС]**

Сообщение от snipe

вы создали макрос
зачем?
вам дали код на событие - вы пишите код макроса

Мне нужно срабатывание только при отправке определенному получателю (группе получателей). Как я писал ранее, у меня нет опыта написания скриптов и я попросил о помощи. Создание макроса и включение его в правило, не будет более легкой задачей?

@snipe · 23.02.2019, 21:49

при возникновении события в код передается
объект и этим объектом является сообщение

Visual Basic
1
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

вот это Item и есть все что связано с сообщением
в том числе и то кому это сообщение отправлено
осталось только проверить если в списке отправки ваш адресат

Добавлено через 1 час 7 минут

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
dim network_path As String
network_path = "\\192.168.1.1\IT\" ' сетевой путь
Dim xMail As Outlook.MailItem
Set xMail = Item
Dim curr_folder As String
curr_folder = network_path & Year(Now) & "." & Month(Now) ' сетевой путь + каталог в формате "гггг.мм"
If InStr(1, Item.To, "user@yandex.ru") > 0 Then 'проверяем адрес куда отправляем и если нужный адрес есть то пытаемся сохраниться
If Dir(curr_folder, vbDirectory) = "" Then ' проверяем, если такого каталога нету
    MkDir curr_folder ' то создаём его
End If
 
xMail.SaveAs curr_folder & "\" & xMail.Subject & ".msg" ' сохраняем письмо, в качестве имени используем тему письма
end if 
End Sub

@Cedo · 24.02.2019, 00:55 **[ТС]**

Подскажи пожалуйста, где это проверить? Мне ведь не нужно что бы все письма сохранялиь.

Увидел. Завтра попробую. Спасибо!

@Cedo · 24.02.2019, 13:49 **[ТС]**

Сообщение от snipe

вот это Item и есть все что связано с сообщением
в том числе и то кому это сообщение отправлено
осталось только проверить если в списке отправки ваш адресат

Адрес указал. Ничего не происходит вообще. Даже папку не создает

Добавлено через 4 часа 12 минут
Вот что у меня получилось:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub CustomMailMessageRule(Item As Outlook.MailItem)
 
    Const network_path As String = "C:\temp\" ' сетевой путь
    Const MSG_FORMAT As String = "msg"
    Const DATE_FORMAT As String = "yyyy.mm"
    Dim sdt As String
    Dim curr_folder As String
    sdt = Format(Now, DATE_FORMAT)
    
    curr_folder = network_path & sdt ' сетевой путь + дата в формате гггг.мм
    If Dir(curr_folder, vbDirectory) = "" Then ' проверяем, если папки нет
        MkDir curr_folder ' то создаем ее
    End If
    
    Item.SaveAs curr_folder & "\" & Item.Subject & "." & MSG_FORMAT ' сохраняем письмо, в качестве имени используем тему письма
    
End Sub

Этот макрос рабочий! Но есть маленькие недочеты:

1. Оказывается, если в теме письма есть кавычки, то это письмо сохранятся не будет. Как можно это обойти? Понятно что кавычки в имени файла недопустимы. Может он может каким то образом их пропускать, не вставлять при сохранении?

2. Не понял как реализовать индекс письма. Например мне нужно скидывать 4 письма в день. название темы у всех писем одинаковое "Осмотр помещения "Такого то" 15.02.2019", ежедневно будет меняться только дата. т.е в день у меня должно получится примерно так:
\\Сетевой путь\2019.02\Осмотр помещения "Такого то" 15.02.2019(1).msg"
\\Сетевой путь\2019.02\Осмотр помещения "Такого то" 15.02.2019(2).msg"
\\Сетевой путь\2019.02\Осмотр помещения "Такого то" 15.02.2019(3).msg"
\\Сетевой путь\2019.02\Осмотр помещения "Такого то" 15.02.2019(4).msg"

Кто сможет мне в этом помочь, буду очень признателен!

@snipe · 24.02.2019, 17:21

есть функция Replace("Строка","какой символ искать","на какой заменять")
т.е. будет примерно так

Visual Basic
1
Item.SaveAs Replace(curr_folder & "\" & Item.Subject & "." & MSG_FORMAT,chr(34),"")

Добавлено через 22 минуты
может к имени файла прицеплять не 1,2,3,4, а время передачи файла
типа
Осмотр помещения "Такого то" 15.02.2019_15:12:15.msg

Добавлено через 13 минут
если да то выглядеть это будет примерно так

Visual Basic
1
Item.SaveAs Replace(curr_folder & "" & Item.Subject & Format(Now(), "dd_mm_yyyy_hh_mm_ss") & "." & MSG_FORMAT,chr(34),"")

Новые блоги и статьи Все статьи Все блоги /
Символьное дифференцирование igorrr37 13.02.2026 / * Логарифм записывается как: (x-2)log(x^2+2) - означает логарифм (x^2+2) по основанию (x-2). Унарный минус обозначается как ! в-строка - входное арифметическое выражение в инфиксной(обычной). . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .	И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»
SDL3 для Web (WebAssembly): Подключение Box2D v3, физика и отрисовка коллайдеров 8Observer8 12.02.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами и вызывать обработчики событий столкновения. . . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 11.02.2026 Содержание блога Библиотека SDL3 содержит встроенные инструменты для базовой работы с изображениями - без использования библиотеки SDL3_image. Пошагово создадим проект для загрузки изображения. . .	SDL3 для Web (WebAssembly): Загрузка PNG с прозрачным фоном с помощью SDL3_image 8Observer8 10.02.2026 Содержание блога Библиотека SDL3_image содержит инструменты для расширенной работы с изображениями. Пошагово создадим проект для загрузки изображения формата PNG с альфа-каналом (с прозрачным. . .	Установка Qt-версии Lazarus IDE в Debian Trixie Xfce volvo 10.02.2026 В общем, достали меня глюки IDE Лазаруса, собранной с использованием набора виджетов Gtk2 (конкретно: если набирать текст в редакторе и вызвать подсказку через Ctrl+Space, то после закрытия окошка. . .

Автоматическое сохранение писем на жесткий диск/сетевую папку

Решение

Решение

@Cedo 1 / 2 / 0 Регистрация: 18.02.2019 Сообщений: 21

	Outlook Автоматическое сохранение писем на жесткий диск/сетевую папку 18.02.2019, 16:28. Показов 13903. Ответов 20 Метки outlook, vba, vba outlook, vba макрос (Все метки) Здравствуйте! Имею Outlook 2010 Суть вопроса такова - Мне необходимо отправлять ежедневные отчеты определенной группе получателей (Доменная сеть). Помимо этого, нужно сохранять копию этого письма на сетевом диске. Знаю, что можно это сделать по средствам создания скрипта. Сам в этом не разбираюсь и очень прошу помочь в этом! Идея такова - я могу настроить правило, которое будет срабатывать при отправке определенному получателю, в котором укажу запуск скрипта, который будет копировать письмо в определенную папку на сетевом диске. В случае недоступности сетевого ресурса, необходимо, что бы он предупреждал об этом и делал повторную попытку. Т.к. отчеты на сетевом диске нужно группировать по году и месяцу, небходимо что бы он автоматически создавал новую папку на новый месяц в формате \2019.02 (гггг.мм) Название письма это - тема письма и в конце нужно добавлять индекс (переменную) Например мне нужно скидывать 4 письма в день. название темы у всех писем одинаковое "Осмотр помещения 15.02.2019", ежедневно будет меняться только дата. т.е в день у меня должно получится "\\Сетевой путь\2019.02\Осмотр помещения 15.02.2019(1).msg" "\\Сетевой путь\2019.02\Осмотр помещения 15.02.2019(2).msg" "\\Сетевой путь\2019.02\Осмотр помещения 15.02.2019(3).msg" "\\Сетевой путь\2019.02\Осмотр помещения 15.02.2019(4).msg" Очень сильно прошу помочь в решении этой задачи! 0

@Loya 70 / 57 / 24 Регистрация: 06.12.2015 Сообщений: 306
	22.02.2019, 15:31
	Добавлено через 27 секунд Cedo, Какая версия офиса и винды? У меня офис 2007 на win10 этот код работает. Есть ли доступ к сетевой папке? В 6-ой строке переменной присваивается путь к сетевому каталогу, в моём случае это: \\192.168.1.1\IT\2019.2\ Проверьте доступ к Вашей директории. Какую именно ошибку выдаёт? 0

@Cedo 1 / 2 / 0 Регистрация: 18.02.2019 Сообщений: 21
	22.02.2019, 15:42 [ТС]
	Loya, Офис 2010, видна 7 про 64x. Ошибка во вложении. Путь доступен! Изображения 0

@Loya 70 / 57 / 24 Регистрация: 06.12.2015 Сообщений: 306
	22.02.2019, 15:43
	И в списке макросов он у меня тоже не отображается, но 100% работает при отправке письма. 0

@Loya 70 / 57 / 24 Регистрация: 06.12.2015 Сообщений: 306
	22.02.2019, 15:48
	А куда Вы код добавляете? Сюда? Макросы в аутлуке включены? 0

@Cedo 1 / 2 / 0 Регистрация: 18.02.2019 Сообщений: 21
	22.02.2019, 15:54 [ТС]
	Добавляю в модуль, макросы включены 0

@Cedo 1 / 2 / 0 Регистрация: 18.02.2019 Сообщений: 21
	22.02.2019, 22:04 [ТС]
	И в списке макросов он у меня тоже не отображается, но 100% работает при отправке письма ___________ А как быть с реализацией того, что мне нужно сохранять письма только отпределенной группы получателей и как это сделать, если в правиле не запускать скрипт? 0

@snipe 4089 / 1469 / 401 Регистрация: 07.08.2013 Сообщений: 3,671
	23.02.2019, 16:14
	вы создали макрос зачем? вам дали код на событие - вы пишите код макроса 1

@Cedo 1 / 2 / 0 Регистрация: 18.02.2019 Сообщений: 21
	24.02.2019, 00:55 [ТС]
	Подскажи пожалуйста, где это проверить? Мне ведь не нужно что бы все письма сохранялиь. Увидел. Завтра попробую. Спасибо! 0