Vba скрытая копия outlook

Обновлено: 07.01.2025

Доступ к элементам папок чаще всего производится через свойство Items объекта папки, которое возвращает коллекцию Items. В этой коллекции находятся все элементы данной папки. Однако единого объекта для элементов Outlook не предусмотрено. Вместо этого в вашем распоряжении — 16 отдельных объектов для каждого вида элементов в Outlook:

Надо сказать, что в подавляющем большинстве случаев вас будут интересовать только объекты MailItem, ContactItem и иногда DocumentItem. На их рассмотрении мы и сосредоточимся.

Dim oOutlook As New Outlook.Application

Dim oMessage As Outlook.MailItem

Set oMessage = oOutlook.CreateItem(olMailItem)

oMessage.Subject = "Привет из VBA"

Рис. 13.3 Предупреждающее окно в Outlook

Что же делать в такой ситуации?

Варианты могут быть разными:

Теперь о самих объектах элементов Outlook. Свойств и методов у этих объектов очень много (например, у объекта ContactItem свойств почти 100), и на рассмотрение их всех потребовалось бы очень много места. В то же время большинство свойств этих объектов очевидны и каких-то проблем при их использовании возникнуть не должно. Обычно единственный вопрос, который может возникнуть — какое программное свойство соответствует определенному атрибуту элемента.

К сожалению, макрорекордера в Outlook не предусмотрено, но понять, как называется то или иное свойство, можно при помощи окна Locals. Применение его может выглядеть так: представим себе, что вам нужно понять, какому программному свойству объекта ContactItem может соответствовать поле Краткое имя.

Первое, что нам нужно сделать — создать контакт, в котором было бы заполнено данное свойство (см. рис. 13.4).

Рис. 13.4 Создаем контакт

Следующее, что нужно сделать — написать программный код, в котором был бы создан объект данного элемента. Например, если этот контакт находится в папке Контакты, то код (из макроса в Outlook) может быть таким:

Dim oNamespace As NameSpace

Dim oFolder As MAPIFolder

Dim oContactItem As ContactItem

Set oNamespace = Application.GetNamespace("MAPI")

Set oFolder = oNamespace.GetDefaultFolder(olFolderContacts)

Set oContactItem = oFolder.Items("Контакт1")

Команда Stop здесь предназначена для того, чтобы остановиться в нужном месте.

Затем нужно запустить наш код на выполнение и, когда он остановится на строке Stop, открыть (при помощи меню View) окно Locals.

В нашем случае вы увидите в нем четыре объекта (см. рис. 13.5).

Рис. 13.5 Окно Locals с объектом контакта

Конечно же, нам нужно развернуть узел объекта oContactItem и поискать его свойство, для которого установлено значение Краткое имя. К своему удивлению, мы можем обнаружить, что это свойство называется EMail1DisplayName (см. рис. 13.6).

Рис. 13.6 Находим свойство с заполненным нами значением в окне Locals

Таким же образом можно находить нужные свойства и для других объектов Item.

Прежде чем начать читать статью прошу принять к сведению объявление: используйте СВОИ АДРЕСА ЭЛ.ПОЧТЫ при тестировании кодов . Не надо отсылать письма на указанные в статье e-mail адреса- это все приходит мне на почту. Помимо этого Вы сами не сможете понять работает или нет, т.к. письма придут мне, а не Вам.
Спасибо за понимание
P.S. А если написанное выше Вы все же проигнорировали и отправили письмо на мои адреса электронной почты - это означает, что Вы соглашаетесь с тем, что вся информация внутри письма, включая вложения, может быть использована мной без ограничений в личных целях.

Отправка через меню Excel
Отправку без кода осуществить достаточно просто:

Далее выбирается способ отправки:

Также можно указать несколько получателей:

Этот код отправляет одно письмо и одно вложение за раз. Но если несколько раз вызвать метод .Attachments.Add, то можно добавить еще файлы:

.Attachments.Add "C:\Temp\Книга1.xlsx" .Attachments.Add "C:\Temp\Книга2.xlsx" .Attachments.Add "C:\Documents\Report.rar"

objOutlookApp.Session.Logon "user","1234",False, True

имеет особое значение. По сути она нужна только в тех случаях, когда в Outlook настроено несколько профилей(не путать с учетными записями) и запускать нужно от конкретного. Если профиль только один или не указан, то Outlook запускается с профилем по умолчанию. Для этого строку нужно записать без параметров(так же можно записать эту строку, если Outlook при попытке создания письма выдает ошибку профиля):

Этот код отправляет одно письмо и вставляет одну картинку. За это отвечает строка

Если картинку надо вложить с заранее указанными размерами, то строка будет выглядеть так:

"<img src=cid:" & Replace(Dir(sPicture, 16), " ", "%20") & " height=240 width=180>" 'height - высота 'width - ширина

Если надо добавить несколько картинок, то метод .Attachments.Add sPicture надо будет вызвать столько раз, сколько картинок(для каждого свой путь к картинке).

Важно помнить: пути для картинок должны содержать полный путь до файла, включая его имя и расширение: C:\Документы\Изображения\Excel_vba_ru.jpg . При указании только имени Excel_vba_ru.jpg или пути без расширения ( C:\Документы\Изображения\Excel_vba_ru ) ошибки не будет, но картинка не будет вставлена, а вместо неё скорее всего будет текст "Ошибка загрузки картинки!" или пустой квадрат вместо реальной картинки.

Outlook 2007 : Меню-Параметры-Центр управления безопасностью-Программный доступ-установить Никогда не предупреждать о подозрительной активности (не рекомендуется)
Outlook 2010 и выше : Файл-Параметры-Центр управления безопасностью-Программный доступ-установить Никогда не предупреждать о подозрительной активности (не рекомендуется)

ВАЖНО: Если компьютер управляется администратором Microsoft Exchange или Microsoft Windows Active Directory Domain Services и администратором в качестве параметров по умолчанию установлен запрет на внесение изменений в параметры безопасности пользователями, возможность изменения данных настроек безопасности программного доступа будет недоступна.

Но так же при отправке файлов и писем часто необходимо не привязываться к конкретной почтовой программе. Ведь далеко не все ставят Outlook. Многие используют иные почтовые программы, например TheBat.

Данный код отправляет письмо, используя объект CDO(Collaboration Data Objects - присутствует во всех версиях Windows) и от имени Вашей учетной записи(либо Яндекс, либо Мэйл, либо Рамблер либо др.).

Это основные моменты. Поля Кому(sTo), От кого(sFrom),Тема письма(sSubject), Текст письма(sBody) и Вложение(sAttachment) думаю не нуждаются в расшифровке.

Чтобы использовать данный код вы можете либо просто скопировать его прямо со страницы, либо скачать файл. В файле программа немного упрощена к использованию - в ячейки листа вам необходимо будет внести поля: Кому(sTo), От кого(sFrom),Тема письма(sSubject), Текст письма(sBody) и Вложение(sAttachment) и выбрать SMTPserver. SMTPserver выбирается из выпадающего списка. Сам список является динамическим и расположен на листе "Settinngs". Там же расположены поля Учетной записи и Пароль, которые автоматически подставляются в необходимые поля на листе "Отправка". Т.к. список динамический Вы можете просто добавлять к уже имеющимся новые сервисы и потом просто выбирать их из списка. Так же в файле есть еще одна возможность - выбрать файл. Для этого надо просто нажать на кнопку и выбрать файл.

Самый главный момент:
AddRelatedBodyPart

в приведенном выше коде картинка вставляется в самом начале письма и после неё так же добавляется перенос на новую строку при помощи тэга

Для автоматического копирования вложений из приходящих в Outlook писем в указанную папку можно воспользоваться правилом, исполняющим ниже прописанный скрипт VBA. Скрипт также модифицирует имя файла в соответствии с датой создания письма. Вариант из примера работает корректно для писем с одним вложением. Для писем с несколькими вложениями нужно изменить код в месте формирования имени файла.

Вставьте код, прописанный ниже, в раздел Modules. Слева найдите Modules. Если там нет раздела нет пункта Module, то создайте такой правым щелчком мыши по Modules. Или нажмите правой кнопкой по Modules, Insert -> Module.
Скопируйте код в главное окно.
Закройте VBA IDE.
Создайте правило, вызывающее скрипт.
В первом окне мастера создания нового правила выберите проверку входящих писем.
В следующем окне выберите правила отбора писем.
В третьем окне выберите «выполнить скрипт» (или «запустить скрипт»). Когда нажмете на подчеркнутое слов «скрипт», должен быть виден код, который был вставлен в консоль VBA.
Нажмите «Завершить» и проверьте работу правила.

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)

Dim objAtt As Outlook.Attachment

Dim saveFolder As String

dateOfMailItem = Format(itm.ReceivedTime, "yyyy.mm.dd" )

If Dir(saveFolder, vbDirectory) = "" Then

For Each objAtt In itm.Attachments

'Проверяем наличие файла с таким же именем

For i = 1 To 1000

If Not Dir(saveFolder & "\" & dateOfMailItem & j & objAtt.FileName) = "" Then

objAtt.SaveAsFile saveFolder & "\" & dateOfMailItem & j & objAtt.FileName

Set objAtt = Nothing

Если часть созданного правила выполняется, но сам скрипт не срабатывает, то, возможно, дело в настройках безопасности Outlook 2010/2013/2016 (в Outlook 2007 и старше эта опция находится в Tools -> Macro Security). Чтобы макрос сработал:

Ниже пример кода, который сохраняет каждое вложение из письма в папку с названием, совпадающим с темой письма. Если вложенные файлы сами являются письмами (т.е. имеют расширение *.msg), то сохраняются только вложения из них в подпапку с названием таким же, как тема вложенного *.msg файла.
Чтобы код работал нужно включить Microsoft Scripting Runtime как описано в другой статье .

Sub saveAttachtoDisk(itm As Outlook.MailItem)

Dim objAtt As Outlook.Attachment

Dim objAttachments As Outlook.Attachment

Dim saveFolder As String

Dim openMsg As MailItem

dateOfMailItem = Format(itm.ReceivedTime, "yyyy.mm.dd" )

If Dir(saveFolder, vbDirectory) = "" Then

For t = 1 To Len(itm.Subject)

s = Mid(itm.Subject, t, 1)

sSubject = sSubject & s

For Each objAtt In itm.Attachments

saveFolderFull = saveFolder & sSubject

If Dir(saveFolderFull, vbDirectory) = "" Then

'Проверяем наличие файла с таким же именем

For i = 1 To 1000

If Not Dir(saveFolderFull & "\" & dateOfMailItem & j & objAtt.FileName) = "" Then

objAtt.SaveAsFile saveFolderFull & "\" & dateOfMailItem & j & objAtt.FileName

'Из msg файлов достаём вложения и удаляем

If LCase(Right(objAtt.FileName, 4)) = ".msg" Then

Set openMsg = Application.CreateItemFromTemplate(saveFolderFull & "\" & dateOfMailItem & j & objAtt.FileName)

For t = 1 To Len(openMsg.Subject)

s = Mid(openMsg.Subject, t, 1)

sSubject2 = sSubject2 & s

If Dir(saveFolderFull & "\" & sSubject2, vbDirectory) = "" Then

MkDir saveFolderFull & "\" & sSubject2

'Сохраняем вложения из msg-файла

For Each objAttachments In openMsg.Attachments

objAttachments.SaveAsFile saveFolderFull & "\" & sSubject2 & "\" & dateOfMailItem & objAttachments.FileName

openMsg. Close olDiscard

Kill saveFolderFull & "\" & dateOfMailItem & j & objAtt.FileName 'Удаляем файл msg-файла

Set objAtt = Nothing

Сохранение письма с вложениями на диск

Если нужно сохранить само письмо, а не только вложения, то код упрощается:

Если нужно, чтобы на входящее собщение у вас автоматически формировался ответ определенного содержания, есть 3 варианта, как это можно сделать в Outlook при помощи правил.

Настроить правило, которое будет обрабатываться на сервере и формировать нужный ответ. Условия срабатывания правила, понятно, могут быть любые - если письмо от какого-то конкретного отправителя, если в теме или тексте содержится некая строка и т.д. и т.п.

Минус в том, что письмо отправляется в том виде, в котором сформировано при настройке правила - без цитирования входящего.

Настраиваем так (для Microsoft Outlook 2013):

Вуаля - как только на сервер поступит письмо, сработает правило и отправителю уйдет настроенное нами письмо.

Настроить правило, которое будет обрабатываться на клиенте - при этом будет отправлено письмо из шаблона.

Минус такой же - письмо отправляется в том виде, в котором сформирован шаблон - без цитирования входящего.

Еще один минус - т.к. правило наботате только на клиенте, письмо будет отправлено только при запуске сессии Outlook (самим Outlook'ом).

Но самый главный минус, о котором мало где упоминается, такие правила срабатывают только по одному разу для отправителя за время сессии Outlook (об этом здесь).

Настройка аналогична Варианту 1, за исключением пункта д). И еще предварительно нужно сделать шаблон письма.

Минус только один - т.к. правило наботате только на клиенте, письмо будет отправлено только при запуске сессии Outlook (самим Outlook'ом).

Вот простейший вариант скрипта. Его недостаток в том, что текст ответа не внедряется в тело HTML в рамках тега <body>. Но при небольших умениях это несложно доработать. ;-)

Public Sub ReplyAuto(AItem As Outlook.MailItem)
Dim strMessageClass As String
Dim mReply As Outlook.MailItem

Dim strMsg As String

strMsg = "Добрый день! <br>" & vbCrLf _
& "Ваше письмо получено.<br>" & vbCrLf _
& "<br>" & vbCrLf

If (strMessageClass = "IPM.Note") Then
Set mReply = AItem.ReplyAll
'mReply.BCC = AItem.BCC

mReply.HTMLBody = strMsg & mReply.HTMLBody

Set mReply = Nothing
End If

Для редактирования скрипта дрлжен быть включен пункт ленты Разработчик (Параметры / Настроить ленту, поставить флаг Разработчик). Далее: лента Разработчик / Visual Basic. В редакторе VBA в левой панели (Project - Проект1) двойной щелчток по ThisOutlookSession (в дереве Проект1 / Microsoft Outlook Objects) - и в правой области редактирования вставляем текст скрипта.

И нужно опять же выбрать другие параметры в п. д)

И тут отсутствует минус первых двух вариантов - отсутствие понимания был ответ или нет, т.к. письмо-ответ сохраняется как и обычный ответ в отправленных.

Читайте также: