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

Author: Siluvia Last Modified: 2025-08-06

本教程展示了一種方法，結合VBA腳本和Outlook規則，幫助您在特定郵件到達Outlook時自動列印其附件。

當特定郵件到達時自動列印附件

步驟1：在Outlook中創建腳本

步驟2：建立使用該腳本的規則

當特定郵件到達時自動列印附件

假設您希望自動列印來自某個特定寄件人的郵件附件。您可以按照以下步驟操作來實現這一目標。

步驟1：在Outlook中創建腳本

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

1. 啟動您的Outlook，同時按下 Alt + F11 鍵以打開 Microsoft Visual Basic for Applications 窗口。

2. 在 Microsoft Visual Basic for Applications 窗口中，雙擊 Project1 > Microsoft Outlook Objects > ThisOutlookSession 以打開 ThisOutlookSession (Code) 窗口，然後將以下代碼複製到此代碼窗口中。

steps of auto printing attachments when emails arrive in Outlook

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

注意事項：

1. 在應用此VBA代碼之前，僅用於列印進來郵件中的PDF文件，您需要先下載並安裝 Adobe Acrobat Reader ，並將其設置為計算機上的默認PDF閱讀器。

2. 在 Case "pdf" 這一行中，請將 "pdf" 更改為您想要列印的文件擴展名。

3. 接下來點擊 Tools > References。在彈出的 References – Project1 對話框中，勾選 Microsoft Scripting Runtime 選項，然後點擊 OK 按鈕。