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 中。我也使用了GetDefaultFolder带有参数的方法olFolderInbox。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 保留了“文件夹”一词。当我需要引用光盘文件夹时，我使用“路径”。我不写Outlook.MailItem或Outlook.Attachment何时MailItem或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。

选择方法二

将以下代码添加到您的模块中：

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”或一些合理的变体。