如何在郵件抵達 Outlook 時自動列印附件？

本教學將示範如何結合 VBA 腳本與 Outlook 規則，在特定郵件抵達時自動列印其附件。

在特定郵件抵達時自動列印附件

若您希望自動列印來自特定寄件者的郵件附件，請依照下列步驟完成設定。

步驟 1：在 Outlook 中建立腳本

首先，您需要在 Outlook 中建立一個 VBA 腳本。

1. 啟動 Outlook，同時按下 Alt＋F11 鍵，即可開啟 Microsoft Visual Basic for Applications 視窗。

2. 在 Microsoft Visual Basic for Applications 視窗中，雙擊 Project 1＞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. 點選工具＞ 參考項目。在彈出的 參考項目 – 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. 在完成設定後，將返回規則與警示對話方塊，您可看到所建立的規則已列於其中，按一下確定按鈕即可完成全部設定。

從現在起，只要收到指定人員寄來的郵件，附件就會自動列印。

相關文章

---

最佳 Office 生產力工具

體驗全新 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

關於此套件⬇ 下載套件💳 購買套件