如何在 Outlook 中实现邮件到达时自动打印附件？

本教程将演示如何结合使用 VBA 脚本与 Outlook 规则，助您在指定邮件到达 Outlook 时自动打印附件。

当特定邮件到达时自动打印附件

假如您希望在收到特定发件人的邮件后，能够自动打印邮件中的附件，请按照以下步骤操作。

步骤 1：在 Outlook 中创建脚本

首先，您需要在 Outlook 中创建一个 VBA 脚本。

1. 启动 Outlook，按下 Alt+F11 组合键，即可打开 Microsoft Visual Basic for Applications 窗口。

2. 在 Microsoft Visual Basic for Applications 窗口中，双击 Project 1 > Microsoft Outlook Objects > 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. 继续点击工具 > 引用，在弹出的 引用 – Project 1 对话框中勾选 Microsoft Scripting Runtime，然后点击确定按钮。

4. 保存代码后，按下 Alt+Q 组合键即可关闭 Microsoft Visual Basic for Applications 窗口。

注意：请确保已在 Outlook 中启用启用所有宏选项。您可以按照以下步骤检查该设置。

步骤 2：新建规则并应用脚本

在 Outlook 中添加 VBA 脚本后，您还需要根据相应条件新建规则，以调用该脚本。

1. 切换到“主页”选项卡，点击规则 > 管理规则和通知。

2. 在规则和通知对话框中，点击新建规则按钮即可创建规则。

提示：如果您的 Outlook 添加了多个电子邮件帐户，请在将更改应用到此文件夹下拉列表中指定要应用规则的账户，否则规则将默认应用于当前指定账户的收件箱。

3. 在第一个规则向导对话框中，在 步骤 1 框中选择对我收到的邮件应用规则，然后点击下一步。

4. 在第二个规则向导对话框中，您需要完成以下操作：

5. 在第三个规则向导对话框中，按照以下方式进行设置。

提示：如果您的规则向导中缺少运行脚本选项，可参考本文方法显示该选项：恢复 Outlook 规则中缺失的“运行脚本”选项。

6. 接下来会弹出另一个规则向导对话框，询问是否设置例外条件。如有需要可勾选例外，否则直接点击下一步按钮即可。

7. 在最后一个规则向导窗口中，您只需为规则命名，然后点击完成按钮即可。

8. 此时会返回到规则和通知对话框，您可以查看已创建的规则，点击确定按钮即可完成全部设置。

从现在开始，凡是收到指定发件人发送的邮件，其附件将自动打印。

相关文章

---

最佳办公效率工具

体验全新 Kutools for Outlook，畅享 100+ 强大功能！立即点击下载，不容错过！

🤖KUTOOLS AI：采用先进 AI 技术，轻松处理邮件，涵盖回复、摘要、优化、扩展、翻译及撰写等功能。

📧 邮件自动化：自动答复（支持 POP 和 IMAP）/定时发送邮件/发送邮件时按规则自动抄送密送/自动转发（高级规则）/自动添加称呼/自动将多收件人邮件拆分为单独信息……

📨 邮件管理：撤回邮件/按主题等条件拦截诈骗邮件/删除重复邮件/高级搜索/整合文件夹……

📁 附件增强：批量保存/批量分离/批量压缩/自动保存/自动拆离/自动压缩……

🌟 界面魔法：😊更多美观时尚表情/重要邮件到达时提醒您/最小化 Outlook 而不是直接关闭……

👍 一键精彩功能：带附件全部答复/反钓鱼邮件/🕘显示发送者当前时间时区……

👩🏼‍🤝‍👩🏻 联系人与日历：批量从选定邮件中提取添加联系人/将联系人组拆分为个人组/移除生日提醒……

在您的首选语言中畅享 Kutools —— 支持英语、西班牙语、德语、法语、中文等 40 多种语言！

一键解锁 Kutools for Outlook，告别等待，立即下载，让效率倍增！

Kutools for Outlook 功能列表      立即下载      前往购买

🚀 一键下载 — 即可获取全部 Office 加载项

强烈推荐：Kutools for Office（5 合 1）

一键下载五个安装包，即可同时获得 Kutools for Excel、Outlook、Word、PowerPoint 和 Office Tab Pro。立即点击下载！

• ✅ 一键便捷：只需一次操作，即可下载全部五个安装包。
• 🚀 轻松应对各类 Office 任务：随时按需安装所需插件，助您高效办公，不容错过！
• 🧰 包含：Kutools for Excel / Kutools for Outlook / Kutools for Word / Office Tab Pro / Kutools for PowerPoint

关于套件⬇ 下载套件💳 购买套件