Как настроить автоматическую печать вложений при получении писем в Outlook?

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

Автоматическая печать вложений при получении определённых писем

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

Шаг 1. Создайте сценарий в Outlook

Прежде всего нужно создать сценарий VBA в Outlook.

1. Запустите Outlook и одновременно нажмите клавиши Alt+F11, чтобы открыть окно Microsoft Visual Basic для приложений.

2. В окне Microsoft Visual Basic для приложений дважды щёлкните по элементу Project1 > Объекты Microsoft Outlook > ThisOutlookSession, чтобы открыть окно ThisOutlookSession (Код), затем скопируйте приведённый ниже код в это окно кода.

Код VBA 1: автоматическая печать вложений (всех типов вложений) при поступлении писем

Sub AttachementAutoPrint(Item As Outlook.MailItem)
'Updated by Extendoffice 20230223
  Dim xFS As FileSystemObject
  Dim xTempFolder As String
  Dim xAtt As Attachment
  Dim xShell As Object
  Dim xFolder As Object, xFolderItem As Object
  Dim xFileName As String
  On Error GoTo xError
  If Item.Attachments.Count = 0 Then Exit Sub
  Set xFS = New FileSystemObject
  xTempFolder = xFS.GetSpecialFolder(TemporaryFolder)
  xTempFolder = xTempFolder & "\ATMP" & Format(Item.ReceivedTime, "yyyymmddhhmmss")
  If Not xFS.FolderExists(xTempFolder) Then
    MkDir (xTempFolder)
  End If
  Set xShell = CreateObject("Shell.Application")
  Set xFolder = xShell.NameSpace(0)
  For Each xAtt In Item.Attachments
    If IsEmbeddedAttachment(xAtt) = False Then
      xFileName = xTempFolder & "\" & xAtt.FileName
      xAtt.SaveAsFile (xFileName)
      Set xFolderItem = xFolder.ParseName(xFileName)
      xFolderItem.InvokeVerbEx ("print")
    End If
  Next xAtt
  Set xFS = Nothing
  Set xFolder = Nothing
  Set xFolderItem = Nothing
  Set xShell = Nothing
xError:
  If Err <> 0 Then
    MsgBox Err.Number & " - " & Err.Description, , "Kutools for Outlook"
    Err.Clear
  End If
Exit Sub
End Sub

Function IsEmbeddedAttachment(Attach As Attachment)
Dim xItem As MailItem
Dim xCid As String
Dim xID As String
Dim xHtml As String
On Error Resume Next
IsEmbeddedAttachment = False
Set xItem = Attach.Parent
If xItem.BodyFormat <> olFormatHTML Then Exit Function
xCid = ""
xCid = Attach.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F")
If xCid <> "" Then
    xHtml = xItem.HTMLBody
    xID = "cid:" & xCid
    If InStr(xHtml, xID) > 0 Then
        IsEmbeddedAttachment = True
    End If
End If
End Function

Примечание: Данный код поддерживает печать вложений всех типов, получаемых в письмах. Если вы хотите печатать только вложения определённого типа, например файлы PDF, используйте следующий код VBA.

Код VBA 2: автоматическая печать вложений указанного типа при поступлении писем

Sub AttachementAutoPrint(Item As Outlook.MailItem)
'Updated by Extendoffice 20230223
  Dim xFS As FileSystemObject
  Dim xTempFolder As String
  Dim xAtt As Attachment
  Dim xShell As Object
  Dim xFolder As Object, xFolderItem As Object
  Dim xFileType As String, xFileName As String
  On Error GoTo xError
  If Item.Attachments.Count = 0 Then Exit Sub
  Set xFS = New FileSystemObject
  xTempFolder = xFS.GetSpecialFolder(TemporaryFolder)
  xTempFolder = xTempFolder & "\ATMP" & Format(Item.ReceivedTime, "yyyymmddhhmmss")
  If Not xFS.FolderExists(xTempFolder) Then
    MkDir (xTempFolder)
  End If
  Set xShell = CreateObject("Shell.Application")
  Set xFolder = xShell.NameSpace(0)
  For Each xAtt In Item.Attachments
    If IsEmbeddedAttachment(xAtt) = False Then
      xFileName = xAtt.FileName
      xFileType = LCase$(Right$(xFileName, VBA.Len(xFileName) - VBA.InStrRev(xFileName, ".")))
      xFileName = xTempFolder & "\" & xFileName
      Select Case xFileType
        Case "pdf"   'change "pdf" to the file extension you want to print
          xAtt.SaveAsFile (xFileName)
          Set xFolderItem = xFolder.ParseName(xFileName)
          xFolderItem.InvokeVerbEx ("print")
      End Select
    End If
  Next xAtt
  Set xFS = Nothing
  Set xFolder = Nothing
  Set xFolderItem = Nothing
  Set xShell = Nothing
xError:
  If Err <> 0 Then
    MsgBox Err.Number & " - " & Err.Description, , "Kutools for Outlook"
    Err.Clear
  End If
  Exit Sub
End Sub

Function IsEmbeddedAttachment(Attach As Attachment)
Dim xItem As MailItem
Dim xCid As String
Dim xID As String
Dim xHtml As String
On Error Resume Next
IsEmbeddedAttachment = False
Set xItem = Attach.Parent
If xItem.BodyFormat <> olFormatHTML Then Exit Function
xCid = ""
xCid = Attach.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x3712001F")
If xCid <> "" Then
    xHtml = xItem.HTMLBody
    xID = "cid:" & xCid
    If InStr(xHtml, xID) > 0 Then
        IsEmbeddedAttachment = True
    End If
End If
End Function

Примечания:

3. Перейдите в пункт меню Сервис > Ссылки. В появившемся диалоговом окне Ссылки – Project1 установите флажок напротив пункта Библиотека времени выполнения сценариев Microsoft, затем нажмите кнопку ОК.

4. Сохраните код и нажмите клавиши Alt+Q, чтобы закрыть окно Microsoft Visual Basic для приложений.

Примечание: Убедитесь, что в Outlook включена опция Включить все макросы. Проверить эту настройку можно, выполнив приведённые ниже шаги.

Шаг 2. Создайте правило для использования сценария

После добавления сценария VBA в Outlook создайте правило, которое будет автоматически применять этот сценарий при выполнении заданных условий.

1. Перейдите на вкладку «Главная», нажмите Правила > Управление правилами и уведомлениями.

2. В диалоговом окне Правила и уведомления нажмите кнопку Создать правило, чтобы создать новое правило.

Совет: Если в вашем Outlook добавлено несколько учётных записей электронной почты, обязательно выберите нужную учётную запись в раскрывающемся списке Применить изменения к этой папке, чтобы правило применялось именно к той папке, которую вы хотите настроить. В противном случае правило будет применено ко входящим письмам текущей учётной записи.

3. В первом диалоговом окне Мастер правил выберите пункт Применить правило к сообщениям, которые я получаю в поле Шаг 1, затем нажмите кнопку Далее.

4. Во втором диалоговом окне Мастер правил необходимо:

5. В третьем диалоговом окне Мастер правил выполните следующую настройку.

Совет: Если в вашем правиле Outlook отсутствует опция «Выполнить сценарий», воспользуйтесь руководством восстановление отсутствующей опции «Выполнить сценарий» в правиле Outlook.

6. Затем появится ещё одно диалоговое окно Мастер правил, запрашивающее исключения. Если нужно, укажите исключения; в противном случае нажмите кнопку Далее без выбора каких-либо параметров.

7. В последнем диалоговом окне Мастер правил укажите имя правила, затем нажмите кнопку Готово.

8. После этого вы вернётесь в диалоговое окно Правила и уведомления, где увидите созданное правило в списке. Нажмите кнопку ОК, чтобы завершить настройку.

Теперь при получении письма от указанного отправителя вложение будет автоматически отправляться на печать.

Связанные статьи

---

Лучшие инструменты для повышения продуктивности в Office

Оцените совершенно новый Kutools для Outlook с 100+ потрясающими функциями!Нажмите, чтобы скачать прямо сейчас!

🤖KUTOOLS AI:Использует передовые технологии ИИ для удобной работы с электронной почтой: ответы, составление резюме, оптимизация, расширение, перевод и создание писем.

📧Автоматизация работы с электронной почтой: Автоответ (доступен для POP и IMAP) / Планирование отправки писем / Авто Копия/Скрытая копия по правилам при отправке писем / Автоматическое перенаправление (расширенное правило) / Автоматическое добавление приветствия / Автоматическое разделение писем с несколькими получателями на отдельные сообщения…

📨Управление электронной почтой: Отозвать письмо / Блокировка спама по теме и другим признакам / Удаление дубликатов писем / Расширенный поиск / Организация папок…

📁Продвинутая работа с вложениями: Пакетное сохранение / Пакетное отсоединение / Пакетное сжатие / Автосохранение / Автоматическое отсоединение / Автоматическое сжатие…

🌟Волшебство интерфейса: 😊Еще больше красивых и стильных эмодзи / Напоминание о важных входящих письмах / Сворачивание Outlook вместо закрытия…

👍Чудеса одним щелчком: Ответить всем с вложениями / Защита от фишинговых писем / 🕘Отображение часового пояса: текущее время отправителя…

👩🏼‍🤝‍👩🏻Контакты и календарь: Пакетное добавление контактов из выбранных писем / Разделение группы контактов на отдельные группы / Удаление напоминания о дне рождения…

Используйте Kutools на вашем любимом языке — поддержка английского, испанского, немецкого, французского, китайского и более чем 40 других языков!

Мгновенно получите доступ к Kutools для Outlook одним щелчком! Не теряйте время — скачайте прямо сейчас и повысьте свою эффективность!

Список функций Kutools для Outlook      Скачать сейчас      Перейти к покупке

🚀 Скачать одним щелчком — Получите все надстройки для Office

Настоятельно рекомендуется: Kutools for Office (5 в 1)

Скачайте одним щелчком пять установщиковсразу —Kutools для Excel, Outlook, Word, PowerPointи Office Tab Pro.Нажмите, чтобы скачать прямо сейчас!

• ✅Удобство одним щелчком: Скачайте все пять установочных пакетов за одно действие.
• 🚀Готовы к любой задаче в Office: устанавливайте нужные надстройки именно тогда, когда они вам понадобятся.
• 🧰Входит в комплект: Kutools для Excel / Kutools для Outlook / Kutools для Word / Office Tab Pro / Kutools for PowerPoint

О пакете⬇ Скачать пакет💳 Приобрести пакет