如何根据收到的时间和主题行在新邮件中保存 Excel 附件？

Posted 2023-05-07

【中文标题】如何根据收到的时间和主题行在新邮件中保存 Excel 附件？

【英文标题】：How do I save Excel attachments in new mail based on both time received and subject line?

【发布时间】：2019-07-07 18:18:37

【问题描述】：

我对编码还很陌生。我想知道如何使用主题行关键字和收到的时间将特定的 Excel 附件保存在 Outlook 收件箱（“早间电子邮件”）中。

我每天都会收到五封新电子邮件，其中包含要保存到同一驱动器文件夹中的 Excel 附件。

收到的时间可以是昨晚也可以是今天凌晨。

所有五个文件的名称和接收时间都不同。

收件箱不为空。我不想保存我昨天或两周前保存的内容。

Sub SaveAttachments()

    Dim ol As Outlook.Application
    Dim ns As Outlook.Namespace
    Dim fol As Outlook.Folder
    Dim i As Object
    Dim mi As Outlook.MailItem
    Dim at As Outlook.Attachment

    Set ol = New Outlook.Application
    Set ns = ol.GetNamespace("MAPI")
    Set fol = ns.Folders(1).Folders("Morning Emails")

    For Each i In fol.Items

        If i.Class = olMail Then

            Set mi = i

            If mi.Attachments.Count > 0 Then
                For Each at In mi.Attachments
                    at.SaveAsFile "C:\Users\nader\OneDrive\Documents\" & _
                      at.Filename & Format(mi.ReceivedTime, " MM-DD-YYYY")
                Next at   
            End If

        End If

    Next i

End Sub

“尝试的操作失败；找不到对象”行：Set fol = ns.Folders(1).Folders("Morning Emails")，即使我在 Outlook 收件箱下创建了该子文件夹。

【参考方案1】：

Set ol = New Outlook.Application

无需在代码中创建新的 Outlook 应用程序实例。使用 Application 属性在 Outlook VBA 宏中获取宿主应用程序实例。

我建议处理Application 类的NewMailEx 事件。对于 Microsoft Outlook 处理的每个收到的项目，此事件都会触发一次。该项目可以是几种不同的项目类型之一，例如MailItem、MeetingItem 或SharingItem。 EntryIDsCollection 字符串包含对应于该项目的条目 ID。

NewMailEx 事件在新邮件到达收件箱时以及在客户端规则处理发生之前触发。您可以使用EntryIDCollection 数组中返回的Entry ID 来调用NameSpace.GetItemFromID 方法并处理该项目。

Private Sub outApp_NewMailEx(ByVal EntryIDCollection As String)    
      Dim itm as Object
      Set itm = NS.GetItemFromID(EntryIDCollection)
      Debug.Print "mail received"
      If itm.Class = olMail Then
        Dim it as Outlook.MailItem
        Set it = itm       
        if it.Subject = "your subject" then 
          If it.Attachments.Count > 0 Then
            For Each at In mi.Attachments
                at.SaveAsFile "C:\Users\nader\OneDrive\Documents\" & _
                    at.Filename & Format(mi.ReceivedTime, " MM-DD-YYYY")
            Next at
          End If
        End If
      End If
End Sub

【讨论】：

嗨尤金感谢您的回复。我将您的代码放在我的 Outlook 模块中（从 Private sub 到 end sub），然后我向我的收件箱发送了一封电子邮件，其中我在宏中设置的标题等于（例如，it.Subject == "Future Rates"）但没有任何保存；事实上，代码不想让我设置它。Subject == 但只是 = ;还是没有做，有什么好的想法吗？

您必须添加NewMailEx 事件处理程序。在左侧列表框中选择Application，在右侧列表框中可以选择需要处理的事件。