Outlook 2016 VBA 將文件夾中的附件保存到特定位置

Question

我在網上找到了這段代碼，並試圖對其進行更改以適合我的目的。 我所需要的只是將來自 test@noreplay.com 的附件保存到我的測試文件夾（它是收件箱的子文件夾）。 我不知道如何更改它，需要您的幫助！

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "C:\Attachments"
    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
        Set objAtt = Nothing
    Next
End Sub

我的 VBA 看起來像這樣（希望它有幫助）。

再次嘗試將 Outlook 中的附件保存到特定文件夾中，來自特定發件人的同名（因此新附件將覆蓋現有附件）。

Answer 1

我給了你很多閱讀和做的事情。 慢慢地完成這一切，並在必要時提出問題。

您的評論表明您對 Outlook VBA 的了解非常有限，因此我將首先進行簡要介紹。 如果您的知識比我懷疑的要好，我深表歉意，但我寧願侮辱您的知識，讓您對我的代碼感到完全困惑。

Outlook VBA簡介

本機 VBA 是一種相當有限的語言。 它帶有許多語句和一些標准函數，但它的大部分功能來自庫。 打開 VBA 編輯器，單擊工具，然后單擊引用，您將看到一長串庫。 列表頂部的一些將已被勾選。 如果您需要他們提供的功能，您可以向下滾動列表並勾選其他人。 是“Microsoft Outlook nn.n 對象庫”告訴編譯器有關文件夾、郵件項目和任務的信息。 是“Microsoft Excel nn.n 對象庫”告訴編譯器有關工作簿、工作表和范圍的信息。 （注意，nn.n 取決於您使用的 Office 版本。）因此，要在 Outlook VBA 中編程，您需要了解 VBA（對於 Excel、Word 和 PowerPoint 將相同）和 Outlook 對象模型。

Outlook 將您的所有電子郵件、日歷項目、任務等保存在它稱為store 的文件中。 您可能會看到這些文件被稱為“PST 文件”，因為大多數文件的擴展名為“PST”。 但是，擴展名為“OST”的 Outlook 文件也是一個存儲。 您可能會看到它們被稱為“帳戶”，因為默認情況下，Outlook 每個電子郵件帳戶都有一個商店。 但是，您可以擁有未鏈接到帳戶的商店； 例如，我的安裝有一個名為“Archive”的存儲和另一個名為“Outlook Data File”的存儲，它們都不是帳戶。

如果您查看可能位於 Outlook 窗口左側下方的文件夾窗格，您可能會看到以下內容：

DoeJA@Gmail.com
   :    :    :    :
   Inbox
   :    :    :    :
  Sent Items
   :    :    :    :
JohnDoe@HotMail.com
   :    :    :    :
   Inbox
   :    :    :    :
  Sent Items
   :    :    :    :
Outlook Data File
   :    :    :    :
   Inbox
   :    :    :    :
  Sent Items
   :    :    :    :

“DoeJA@Gmail.com”、“JohnDoe@HotMail.com”和“Outlook Data File”是商店的名稱。 文件名可能是“DoeJA@Gmail.com.OST”、“JohnDoe@HotMail.com.PST”和“Outlook Data File.PST”。 然而，VBA 程序員對文件名不感興趣。 文件夾窗格中顯示的名稱是重要的名稱。

VBA 的一個令人惱火的特性是通常有不止一種方法可以實現相同的效果。 考慮：

Option Explicit
Sub DsplSingleEmail1()

  Dim NS As NameSpace
  Dim FldrSrc As Folder

  Set NS = Application.GetNamespace("MAPI")
  Set FldrSrc = NS.Folders("DoeJA@Gmail.com").Folders("Inbox")

  With FldrSrc.Items(1)
    Debug.Print .ReceivedTime & " " & .Subject
  End With

End Sub
Sub DsplSingleEmail 2()

  Dim FldrSrc As Folder

  Set FldrSrc = Session.Folders("DoeJA@Gmail.com").Folders("Inbox")

  With FldrSrc.Items(1)
    Debug.Print .ReceivedTime & " " & .Subject
  End With

End Sub
Sub DsplSingleEmail 3()

  Dim FldrSrc As Folder

  Set FldrSrc = CreateObject("Outlook.Application"). _
                        GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

  With FldrSrc.Items(1)
    Debug.Print .ReceivedTime & " " & .Subject
  End With

End Sub

所有三個宏都輸出收到的日期和時間以及幾乎可以肯定是收件箱中最舊電子郵件的主題。 如果您想在您的系統上試用它們，您必須將“DoeJA@Gmail.com”替換為您系統上具有活動收件箱的商店名稱。

在宏DsplSingleEmail1 ，我使用了方法GetNamespace 。 在宏DsplSingleEmail2 ，我使用了方法Session 。 文檔說這兩種方法是等效的，但我沒有找到解釋為什么有兩種等效方法。 如果您編寫自己的代碼，這並不重要； 選擇您喜歡的任何方法。 但是，如果您打算在線查找代碼片段，則必須為程序員 A 使用一種方法而程序員 B 使用另一種方法做好准備。 當您合並使用不同方法的片段時，您必須充分了解所有方法才能調整代碼以使用您最喜歡的方法。

GetNamespace和Session都是Application方法。 在一個宏中，我已經告訴編譯器這一點，而在另一個宏中，我讓編譯器自己解決這個問題。

在宏DsplSingleEmail3 ，我使用了Namespace方法，但已使用CreateObject("Outlook.Application")開始我的語句。 如果我從 Excel 運行此代碼，這將是必要的，但在這里不需要，因為我已經在 Outlook 中。 我還使用了帶有參數olFolderInbox方法GetDefaultFolder 。 Outlook 默認將其所有標准文件夾都存儲在“Outlook 數據文件”中。 但是，在我的系統上，安裝向導已安排將我的電子郵件導入到另外兩家商店。 毫無疑問，某處有更改默認值的功能，但我從來沒有費心去查看，因為我不知道我會將哪個商店的收件箱設為默認值。 DsplSingleEmail3在我的系統上運行的唯一原因是我將一些垃圾郵件復制到“Outlook 數據文件”中的收件箱。 我包括Debug.Print FldrSrc.Parent.Name因為它輸出包含默認收件箱的商店的名稱。

上面的目的是為了演示在沒有了解上下文的背景的情況下查找代碼片段的一些問題。 您發現的片段的作者似乎假設讀者會理解如何使用它。 我從一本書中學習了 Excel VBA。 我參觀了一個大型圖書館並借用了他們所有的 Excel VBA 入門書。 在家里，我嘗試了所有這些，然后購買了與我的學習風格相匹配的那一款。 我通過實驗學習了 Outlook VBA，因為我找不到適合 Outlook VBA 的入門讀物。 我懷疑是否有可能通過在線查找有用的代碼來學習 Excel 或 Outlook VBA。 如果您想編寫宏來幫助您的雇主，您必須安排一些減輕您正常工作量的工作，以便您有不受干擾的時間來學習 VBA 和 Outlook 對象模型。 這種緩解將很快回報您的雇主，因為您將能夠編寫宏，從而節省您的同事和您自己的工作時間。

滿足您的要求

我發現編寫宏來處理電子郵件分為兩部分。 第 1 部分是決定如何最好地選擇要處理的電子郵件。 第 2 部分是決定如何通過處理選定的電子郵件來實現您希望達到的任何效果。 我將描述四種不同的選擇電子郵件的方法，並展示如何使用這些方法中的每一種。 但是，我將僅提供一個宏來處理選定的電子郵件。 四種選擇方法中的每一種都將調用相同的處理宏。 這表明確實有兩個部分，並將向您展示不同的選擇方法是如何工作的，並決定哪個最適合您當前和未來的要求。

我的處理宏比你的稍微復雜一點。 您的宏是專門為使用規則而設計的。 我的宏將處理用戶選擇、掃描文件夾、新項目事件和規則。

我對您的要求的理解是：來自“test@noreplay.com”的電子郵件帶有附件。 附件將被保存到“C:\\Attachments”，用相同的DisplayName覆蓋任何以前的附件。 處理后的郵件將移至收到郵件的收件箱下的“Test”文件夾中。 您已使用規則移動電子郵件，但不知道如何使用規則保存附件。

盡管我做了一些更改，但我的處理宏的第一部分與您的相似。 由於 Outlook 宏必須與 Outlook 文件夾一起使用，因此我為 Outlook 保留了“文件夾”一詞。 當我需要引用光盤文件夾時，我使用“路徑”。 當MailItem或Attachment可以時，我不寫Outlook.MailItem或Outlook.Attachment 。 如果編譯器不知道哪個庫定義了MailItem和Attachment ，您將需要前綴“Outlook”； 這在這里不適用。 我不知道哪個商店包含您要檢查的收件箱，因此將其稱為“DoeJA@Gmail.com”。 將此名稱替換為您的商店名稱。 我是With語句的忠實用戶，並包含了兩個。

請注意，有不同類型的附件。 我從未見過某些類型，因此不知道它們是否具有DisplayName但您的電子郵件可能只有最常見的附件類型。 如果您在保存附件時遇到問題，請描述問題，我會建議如何避免該問題。 SaveAsFile在沒有警告的情況下覆蓋任何具有相同名稱的現有文件。 這不是問題，因為這符合您的要求。

您使用規則將電子郵件移動到所需文件夾，但只有我的一個選擇宏使用規則，因此處理宏必須在必要時移動電子郵件。 如果電子郵件已經在“收件箱”文件夾中的“測試”文件夾中，則不需要移動它。

所有郵件項目都有包含它們的文件夾作為父項。 一個文件夾要么在另一個文件夾中，要么在一個商店中。 包含文件夾或存儲是文件夾的父級。 商店沒有父級。 在我的處理宏中，您會發現：

With ItemCrnt
  If .Parent.Name = "Test" And .Parent.Parent.Name = "Inbox" Then
    ' MailItem is already in destination folder
  Else
    .Move FldrDest
  End If
End With

ItemCrnt.Parent.Name是包含郵件項目的文件夾的名稱。 如果郵件項目位於所需文件夾中，則此名稱將為“Test”。 ItemCrnt.Parent.Parent.Name是包含郵件項目文件夾的文件夾的名稱。 如果郵件項目位於所需文件夾中，則此名稱將為“收件箱”。 因此，如果郵件項目不在目標文件夾中，則此代碼會將郵件項目移動到目標文件夾。 請注意我如何將屬性與點串在一起。 小心使用此功能。 商店沒有父級，因此如果ItemCrnt在文件夾“Test”中，則ItemCrnt.Parent.Parent.Parent.Name將給出錯誤。

第一個選擇宏SelectEmailsUser要求用戶在運行處理宏之前選擇一封或多封電子郵件。 我從未在實時安裝中使用過這種方法，但在開發過程中發現它非常寶貴。 通過這種方法，我可以從一封易於處理的電子郵件開始。 當我測試處理宏時，我可以在一次運行中慢慢引入越來越復雜的電子郵件和幾封電子郵件。 沒有其他方法可以對電子郵件呈現給宏的順序提供相同的控制。

第二個選擇宏SelectEmailsScan使用我最常用的方法。 使用這種方法，我會向上或向下閱讀文件夾，檢查每封電子郵件的屬性並決定我希望處理哪些電子郵件。

如果您使用簡單的 For-Loop，您希望移動處理過的電子郵件，這會帶來復雜性。 文件夾是集合的一個示例。 對於集合，您通常按位置訪問其成員：1、2、3、4 等。 如果您將郵件項目 5 移動到另一個文件夾，您將從該文件夾中刪除該郵件項目並將其添加到另一個文件夾中。 刪除郵件項 5 后，郵件項 6 將變為郵件項 5，郵件項 7 將變為郵件項 6，依此類推。 如果您的 For-Loop 現在檢查郵件項 6，則您正在檢查舊郵件項 7 並忽略舊郵件項 6。有許多變通方法，但最簡單的是按相反順序檢查電子郵件：1000， 999、998 等等。 現在，如果您刪除電子郵件 998，您不會介意電子郵件 1000 和 999 更改位置，因為您已經檢查過它們。

第三個選擇宏InboxItems_ItemAdd使用一個新的項目事件。 每次發生某些事情時，您都可以要求 Outlook 運行宏。 當新電子郵件添加到文件夾收件箱時，我的代碼要求 Outlook 運行宏。 如果電子郵件是由特定發件人發送的，則此宏調用我的處理宏。 這符合您的規則，只是我的宏將電子郵件移動到文件夾“Test”並保存附件。

第四種選擇方法涉及將“腳本”鏈接到規則。 此規則必須選擇“test@noreplay.com”發送的電子郵件。 或者，此規則可以將選定的電子郵件移動到文件夾“Test”。 如果沒有，我的處理宏將移動它。 規則選項是“運行腳本”，這令人困惑。 有多種腳本語言，包括 VBscript。 “腳本”不能使用任何這些腳本語言； 它必須是 Outlook VBA 宏。

由於信息沖突，規則選項“運行腳本”也令人困惑。 一些網站說微軟已禁用它並提供有關如何取消禁用它的復雜說明。 其他網站沒有提到任何此類問題。 規則選項“運行腳本”適用於我的系統，所以我只能希望它適用於您的系統。 如果它不起作用，您將不得不選擇其他方法之一。

安裝和測試

我已經盡可能模擬了你的系統。 我有兩個電子郵件地址，分別稱為 Address1 和 Address2。 Address1 是我的主要地址，我的家人、朋友和選定的供應商都知道它。 地址 2 是我公開發布的地址，如果被太多騙子竊取，我將丟棄該地址。

我在 Address1 的“收件箱”下創建了一個 Outlook 文件夾“Test”。 我創建了一個光盤文件夾“C:\\Attachments”。 我監視從地址 2 到達地址 1 的電子郵件。 您將不得不更改我的商店名稱，否則我的宏應該在您的系統上保持不變。

請刪除您現有的規則。 我需要你刪除你的規則，因為 (1) 它會干擾選擇方法 1 到 3 和 (2) 我無法發現如何向現有規則添加腳本。 請刪除您不需要的現有代碼。

您的圖像顯示您已將代碼放置在 Module1 中。 當您開始新項目時，您可以添加 Module2、Module3 等。 很快就很難找到包含您今天要查看的代碼的模塊。 您已打開“屬性”窗口。 （F4 打開屬性窗口，如果它現在關閉。）模塊的唯一屬性是它的名稱，您可以從默認的 ModuleNN 更改它。 我建議您將“Module1”重命名為“ModXxxxx”，其中“Xxxxx”是一個對您有意義的名稱。 “Mod”不是必需的，但我覺得它很有幫助。 如果模塊“Xxxxx”中有宏“Xxxxx”，則無法訪問該宏。 通過使用前綴“Mod”命名我的所有模塊，我避免了這個問題。

在每個模塊的頂部都有Option Explicit 。 查看此聲明以了解它提供的好處。 在我的代碼中查找您不認識的任何語句。 如有必要，請提出問題，但您自己研究得越多，您的發展就越快。

如果你想嘗試宏 DsplSingleEmail1 到 DsplSingleEmail3，你可以從這個答案復制並粘貼到你的模塊。 如果您想嘗試 Experiment3，您可能需要復制一些垃圾郵件來存儲“Outlook 數據文件”。

選擇方法一

將以下代碼復制到您的模塊中：

Public Sub SaveAttachAndMoveEmail(ByRef ItemCrnt As MailItem)

  Dim Attach As Attachment
  Dim FldrDest As Folder
  Dim PathSave As String

  PathSave = "C:\Attachments"
  Set FldrDest = Session.Folders("Address1").Folders("Inbox").Folders("Test")

  With ItemCrnt
    For Each Attach In .Attachments
      With Attach
        .SaveAsFile PathSave & "\" & .DisplayName
      End With
    Next

    If .Parent.Name = "Test" And .Parent.Parent.Name = "Inbox" Then
      ' MailItem is already in destination folder
    Else
      .Move FldrDest
    End If

  End With


End Sub
Sub SelectEmailsUser()

  Dim Exp As Explorer
  Dim ItemCrnt As MailItem

  Set Exp = Outlook.Application.ActiveExplorer

  If Exp.Selection.Count = 0 Then
    Call MsgBox("Pleaase select one or more emails then try again", vbOKOnly)
    Exit Sub
  Else
    For Each ItemCrnt In Exp.Selection
      With ItemCrnt
        Debug.Print .ReceivedTime & "|" & .Subject & "|" & .SenderEmailAddress
      End With
      Call SaveAttachAndMoveEmail(ItemCrnt)
    Next
  End If

End Sub 

宏SaveAttachAndMoveEmail是我在上面解釋的處理宏。 將“Address1”替換為包含您要監控的收件箱的商店的名稱。 宏SelectEmailsUser使用ActiveExplorer訪問用戶選擇的電子郵件。 該宏將每封電子郵件的一些屬性輸出到立即窗口。 為了測試宏，我選擇了一些帶有或不帶有附件的電子郵件以及“Test”文件夾內外的電子郵件。 我假設您的電子郵件都在“測試”中。 為什么不將一些移回收件箱，然后選擇並運行宏SelectEmailsUser 。

選擇方法2

將以下代碼添加到您的模塊中：

Sub SelectEmailsScan()

  Dim FldrSrc As Folder
  Dim InxItemCrnt As Long

  Set FldrSrc = Session.Folders("myemail@gmail.com").Folders("Inbox")

  For InxItemCrnt = FldrSrc.Items.Count To 1 Step -1
    With FldrSrc.Items.Item(InxItemCrnt)
      If .Class = olMail Then
        If .SenderEmailAddress = "myemail@gmail.com" Then
          Call SaveAttachAndMoveEmail(FldrSrc.Items.Item(InxItemCrnt))
        End If
      End If
    End With
  Next

End Sub

將“Address1”替換為包含您要監控的收件箱的商店的名稱。

我通過從我的第二個帳戶向我的第一個帳戶發送電子郵件來測試此代碼（以及后來的代碼）。 您可以通過將“test@noreplay.com”之前發送的電子郵件從“Test”文件夾移動到“Inbox”文件夾來測試此代碼。 正如我所說，這是我使用最多的方法。 讓 Outlook 監控有趣的電子郵件似乎更容易，但我發現當我希望更符合我的生活方式時，可以控制運行宏。

選擇方法三

在 VBA 編輯器中，項目資源管理器窗口通常位於左側。 最上面一行是“Microsoft Outlook 對象”。 如果此行有一個“+”，請單擊“+”展開“Microsoft Outlook 對象”。 下一行是“ThisOutlookSession”。 單擊“ThisOutlookSession”以選擇它。 代碼區變為空白。 以前，您會在模塊中看到代碼。 “ThisOutlookSession”是另一個可以放置代碼的區域。 您可以在此處放置任何代碼，但我保留它用於必須放置在此處的代碼。 將以下代碼復制到“ThisOutlookSession”中：

Option Explicit
Private WithEvents InboxItems As Items
Private Sub Application_Startup()
  Set InboxItems = Session.Folders("Address1").Folders("Inbox").Items
End Sub
Private Sub InboxItems_ItemAdd(ByVal ItemCrnt As Object)
  With ItemCrnt
    If .Class = olMail Then
      If .SenderEmailAddress = "test@noreplay.com" Then
        Call SaveAttachAndMoveEmail(ItemCrnt)
      End If
    End If
  End With
End Sub   

Private WithEvents InboxItems As Items定義對象InboxItems 。

Private Sub Application_Startup() … End Sub指定一個在 Outlook 啟動時要運行的子例程。 擁有這樣一個子程序意味着 Outlook 會立即詢問您是否要啟用宏。 如果您想要監控事件，您必須回答“是”。

Set InboxItems = Session.Folders("Address1").Folders("Inbox").Items標識您要監視的文件夾。 當一個項目被添加到這個文件夾時，子程序Xxxxx_ItemAdd被執行。 Xxxxx是您定義Private WithEvents …的對象的名稱。 您可以監控任意數量的文件夾，只要為每個文件夾指定一個單獨的WithEvents對象。

宏InboxItems_ItemAdd的代碼檢查該項目是否為郵件項目並由“test@noreplay.com”發送。 如果這些都是真的，它會調用我的處理宏。 您將需要退出 Outlook（不要忘記保存“VbaProject.OTM”），然后重新啟動它以激活收件箱的監控。

如果您在收到來自“test@noreplay.com”的郵件項目時正在查看收件箱，您會看到它短暫地出現，然后隨着它移至文件夾“Test”而消失。 我通過從我的第二個電子郵件地址發送電子郵件來測試事件監控。 您將不得不等待來自 test@noreplay.com 的電子郵件。

選擇方法4

在設置方法 4 之前，您需要禁用方法 3。您可以從“ThisOutlookSession”中刪除代碼，但我將引號放在左邊緣以將所有語句轉換為注釋，以便下次我需要監視事件。 禁用方法 3 后，關閉 Outlook 並重新打開它。

您將需要創建一個新規則來替換我讓您刪除的規則。 我為測試此方法而創建的規則從我的 Address2 中選擇了電子郵件。 它沒有將這些電子郵件移至“測試”，因為我的處理宏會這樣做。 我的規則包括運行一個你沒有的腳本。 我創建此規則的步驟是：

• 將目標電子郵件之一從“測試”移動到“收件箱”。
• 選擇該目標電子郵件。
• 在主頁選項卡上，單擊“規則”。
• 單擊“創建規則”。 出現“創建規則”窗口。
• 勾選“來自 test@noreplay.com”。
• 檢查沒有其他任何東西被勾選。
• 點擊“高級”。 出現“規則向導”窗口。
• 勾選“來自 test@noreplay.com”，但沒有勾選其他內容。
• 點擊下一步”。 出現另一個“規則向導”窗口。
• 單擊列表底部附近的“運行腳本”。
• 檢查沒有其他任何東西被勾選。
• 在底部的步驟 2 框中單擊“腳本”。 如果您之前在 Outlook 運行中沒有這樣做，系統會要求您啟用宏。 出現“選擇腳本”窗口。
• 選擇“Project1.SaveAttachAndMoveEmail”並單擊“確定”。 注 1：宏名稱可能會被截斷。 注2：此選項可能已被選中，是您唯一的選擇。
• 點擊下一步”。 出現另一個“規則向導”窗口。
• 檢查沒有勾選。
• 點擊下一步”。 出現最終的“規則向導”窗口。
• 如果您不喜歡 Outlook 的默認名稱，請為規則輸入一個不同的名稱。
• 您可能希望勾選“立即對收件箱中已有的郵件運行此規則”以刪除您從“測試”中移出的電子郵件。
• 單擊“完成”。 如果您勾選了“立即對收件箱中已有的郵件運行此規則”，您將在規則運行時看到一個進度窗口。

我找不到關於“運行腳本”選項的任何好的文檔。 我的實驗表明，“選擇腳本”窗口中列出的宏必須是Public並且必須具有符合此類宏規則的參數列表。 我讀過這樣的宏可以有四個參數。 第一個參數是強制性的，但其他參數可以省略。 第一個參數必須是“ByRef itm As MailItem”或一些合理的變體。