Question

我正在尝试使用Outlook VBA在启动时检查我的所有电子邮件，并且每当我收到新电子邮件时，就查看电子邮件主题是否为“示例每日数据提取”。如果电子邮件主题匹配，我希望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将邮件项目，日历项目，任务和其他此类信息保存在它称为商店的文件中。您可以有多个商店，每个商店都有一个收件箱。我是一个拥有两个电子邮件帐户的家庭用户。我进行了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
  :    :    :

许多编程语言都有 Assertion语句；这是VBA的版本它允许程序员断言某些事情是正确的。如果断言为假，则执行将停止。我发现Debug.Assert False在测试过程中非常宝贵。 Debug.Assert 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并不是编写可正常失败的代码的理想语言，但是您可以小心地创建一些可以接受的错误处理代码。

保存新电子邮件中的附件

1 个答案: