保存附件返回 91 错误或不保存

Posted 2023-05-07

【中文标题】保存附件返回 91 错误或不保存

【英文标题】：Saving attachments either returns 91 error or does not save

【发布时间】：2019-01-23 16:32:38

【问题描述】：

我正在尝试在 ThisOutlookSession 中设置一个宏来将附件保存到文件中。

我之前使用了规则和“运行脚本”，但并非对所有用户都启用。

以下代码要么返回 91 错误（未设置对象或变量），要么运行无错误，但不保存。

代码正在查看子文件夹，以根据主题将所有附件保存到某个位置。邮件通过规则发送到子文件夹。

我想根据 ReceivedTime 重命名附件，我认为这就是问题所在。如果我使用 Msg.ReceivedTime，我会收到 91 错误。如果我使用Item.ReceivedTime，没有错误，但是文件没有保存。

这里是我导出大部分代码和定制的源代码。 https://www.tachytelic.net/2017/10/how-to-run-a-vba-macro-when-new-mail-is-received-in-outlook/

Private WithEvents folderItems 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 folderItems = objectNS.GetDefaultFolder(olFolderInbox).Folders("Operations").Folders("Test").Items
End Sub

Private Sub folderItems_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim att As Outlook.Attachment
Dim msg As Outlook.MailItem
Dim filepath As String, filedate As String
filepath = "C:\Documents\"
filedate = Format(Item.ReceivedTime, "YYYYMMDD") 'This is the line which I think is the problem. If I do Msg.ReceivedTime, I get 91 error, but if I do Item.ReceivedTime, it does not save
If TypeName(Item) = "MailItem" Then
    If InStr(Item.Subject, "XXX") > 0 Then
        For Each att In Item.Attachments
            att.SaveAsFile filepath & "XXX\" & filedate & "_raw.csv"
        Next
   ElseIf InStr(Item.Subject, "YYY") > 0 Then
        For Each att In Item.Attachments
            att.SaveAsFile filepath & "YYY\" & filedate & "_raw.xlsx"
        Next
    ElseIf InStr(Item.Subject, "ZZZ") > 0 Then
        For Each att In Item.Attachments
            att.SaveAsFile filepath & "ZZZ.csv"
        Next
    End If
End If
ExitNewItem:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ExitNewItem
End Sub

我的假设是 ReceivedTime 是问题所在。如果我可以使用 Msg.ReceivedTime，我该如何设置变量？或者，如果 Item.ReceivedTime 正确，为什么不保存？

【问题讨论】：

问题是 - item 什么都不是 - 您必须将 set item 分配给参考

如何分配对项目的引用？我希望项目引用进入此文件夹的每封新邮件。

查看下面的答案并告诉我-谢谢

谢谢！完美运行。

【参考方案1】：

试试下面的

Dim att As Outlook.attachment
Dim msg As Outlook.MailItem
Dim filepath As String, filedate As String

filepath = "C:\Documents\"

If TypeName(Item) = "MailItem" Then
    Set msg = Item
    Debug.Print msg.ReceivedTime ' print on Immediate Window
    filedate = Format(msg.ReceivedTime, "YYYYMMDD")

    If InStr(msg.Subject, "XXX") > 0 Then
        For Each att In msg.Attachments
            att.SaveAsFile filepath & "XXX\" & filedate & "_raw.csv"
        Next
   ElseIf InStr(msg.Subject, "YYY") > 0 Then
        For Each att In msg.Attachments
            att.SaveAsFile filepath & "YYY\" & filedate & "_raw.xlsx"
        Next
    ElseIf InStr(msg.Subject, "ZZZ") > 0 Then
        For Each att In msg.Attachments
            att.SaveAsFile filepath & "ZZZ.csv"
        Next
    End If
End If

当代码在 Outlook 应用程序中运行时，您也不需要outlookApp，只需使用应用程序即可。

例子

Private Sub Application_Startup()
  Dim objectNS As Outlook.NameSpace

  Set objectNS = Application.GetNamespace("MAPI")
  Set folderItems = objectNS.GetDefaultFolder(olFolderInbox) _
                            .Folders("Operations") _
                            .Folders("Test").Items
End Sub