Question

我正在尝试在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是正确的，为什么不保存？

Answer 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 Application中运行时，您也不需要outlookApp，只需使用Application。

示例

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

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

1 个答案: