从新电子邮件中保存附件

Question

我正在尝试使用 Outlook VBA 在启动时检查我的所有电子邮件，并在收到新电子邮件时查看电子邮件主题是否为“Sample Daily Data Pull”。如果电子邮件主题匹配，我希望 Outlook 将附件保存到指定的网络驱动器文件夹。这是我的代码：

在“ThisOutlookSession”中

Option Explicit

Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
  Dim outlookApp As Outlook.Application
  Dim objectNS As Outlook.NameSpace
  Set outlookApp = Outlook.Application
  Set objectNS = outlookApp.GetNamespace("MAPI")
  Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub inboxItems_ItemAdd(ByVal Item As Object)
Dim Msg As Outlook.MailItem
If TypeName(Item) = "MailItem" Then
    If Item.Subject = "Sample Daily Data Pull" Then
    Call SaveAttachmentsToDisk
    Else
    End If
End If
End Sub

我在一个模块中也有以下代码：

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String

sSaveFolder = "N:\SampleFilePath\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub

这是我第一次在 Outlook VBA 中工作，所以如果这是非常基本和显而易见的事情，我深表歉意。不太确定出了什么问题，因为我没有收到任何错误消息。我所知道的是，宏没有按应有的方式将附件保存在我的网络驱动器上。

提前感谢您的帮助。

Answer 1

您的代码对我不起作用，因为：

Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items

Outlook 将邮件项目、日历项目、任务和其他此类信息保存在它称为 Stores 的文件中。您可以拥有多个商店，每个商店都有一个收件箱。我是拥有两个电子邮件帐户的家庭用户。我进行了 Outlook 的默认安装，然后使用向导为我的每个电子邮件地址添加了一个帐户。结果是我开了三间店：

• Outlook 数据文件
• MyName@myisp.com
• MyName@gmail.com

“Outlook 数据文件”是默认存储并包含默认收件箱，但新电子邮件放置在其他两个存储的收件箱中。要测试您是否有同样的问题，请打开 Outlook，打开 VBA 编辑器，在您的即时窗口中输入以下内容，然后按 [Return]。

    ? Session.GetDefaultFolder(olFolderInbox).Parent.Name

在我的系统上，此语句输出“Outlook 数据文件”，因为该商店包含默认收件箱。如果我想为新电子邮件创建一个事件处理程序，我需要：

Private Sub Application_Startup()
  Set InboxItems = Session.Folders("MyName@myisp.com").Folders("Inbox").Items
End Sub

这是一个比你的宏更短的人，我稍后会解释，但主要区别在于我正在命名我希望监控的收件箱。如果接收新电子邮件的收件箱不是 Outlook 的默认收件箱，则您必须命名包含您要监控的收件箱的文件夹。

为什么我的宏比你的短这么多？

 Dim outlookApp As Outlook.Application
 Set outlookApp = Outlook.Application

您已经在 Outlook 中，因此这些语句是多余的。

你可以替换：

Set objectNS = outlookApp.GetNamespace("MAPI")

由

Set objectNS = Application.GetNamespace("MAPI")

但你不必这样做。唯一的GetNamespace 在Application 之下，因此资格是可选的。我知道的唯一非可选条件是Outlook.Folder 和Scripting.Folder。如果您在 Outlook 中编写 Folder，则假定您需要其中一个文件夹。如果你想引用磁盘文件夹，你必须这样说。

你有：

Dim objectNS As Outlook.NameSpace
Set objectNS = outlookApp.GetNamespace("MAPI")

我用过Session。文档指出Namespace 和Session 是相同的。我更喜欢Session，但大多数人似乎更喜欢Namespace。您的选择。

如果您引用了正确的收件箱，我们需要进一步寻找问题的原因。

下一个可能的问题是If Item.Subject = "Sample Daily Data Pull"。这要求Item.Subject 完全等于"Sample Daily Data Pull"。一个额外的空格或一个小写字母，它们不相等。

接下来，我建议在每个程序的顶部添加一个语句来给出：

Private Sub Application_Startup()
Debug.Assert False
  :    :    :
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
Debug.Assert False
  :    :    :
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Debug.Assert False
  :    :    :

许多编程语言都有断言声明；这是 VBA 的版本。它允许程序员断言某事将是真实的。如果断言为假，执行将停止。我发现Debug.Assert False 在测试过程中非常宝贵。 Debug.Assert False 将始终为 false，因此执行将始终停止。这是测试Application_Startup、inboxItems_ItemAdd 和SaveAttachmentsToDisk 是否正在执行的简单方法。

试试上面的建议。如果他们没有发现问题，我们将不得不尝试其他方法。

错误处理

在您原来的帖子中，您有：

On Error GoTo ErrorHandler
     :        :       :

     :        :       :

ExitNewItem:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description

你会经常看到这样的代码，但我从来没有看到过这样做的理由。

如果在开发过程中发生错误，此代码将导致显示错误编号和描述并退出例程。这有什么帮助？它让您从错误描述中猜测哪个语句失败。如果省略所有错误代码，则执行会在错误语句处停止。没有人猜测哪个陈述是错误的。如果您可以修复错误，您可以单击 F5 并使用先前错误的语句重新启动。即使无法修复并重新启动，您也可以更好地了解情况。

对于一个实时系统，我很难想象有什么比错误导致显示神秘错误消息和宏终止更不友好的事情。

对于实时系统，您需要以下内容：

Dim ErrNum As Long
Dim ErrDesc As String

On Error Resume Next
Statement that might fail
ErrNum = Err.Num
ErrDesc = Err.Description
On Error GoTo 0
If ErrNum > 0 Then
  ' For each possible value for ErrNum, code to provide user friendly
  ' description of what has gone wrong and how to fix it.
End If

VBA 不是编写优雅失败的代码的理想语言，但小心您可以创建一些非常可接受的错误处理代码。