VBA实现Outlook按日期下载附件仅返回最旧邮件问题咨询

• Outlook账户每日会收到1封带附件的系统自动生成邮件，需要实现每日自动下载对应附件到指定本地文件夹的功能
• 现有代码测试时可通过Debug.Print输出目标文件夹内所有MailItem对象，但执行时仅能处理时间最早的旧邮件，无法正确获取当日邮件的附件

• 语法结构错误：If olItem.Class = olMail 判断块与循环嵌套错位，Next olItem 被错误放置在End If之前，执行逻辑顺序混乱
• 无日期筛选逻辑：遍历文件夹时未判断邮件接收日期是否为当日，会无差别处理所有历史邮件
• 关键变量未赋值：保存路径使用的Filename变量从未定义赋值，目标文件夹参数Folders("")为空字符串，未指定正确的目标邮件文件夹
• 路径格式错误：保存路径中使用/作为日期分隔符，Windows系统本地路径以\作为层级分隔符，/会导致路径解析异常，文件保存位置错误
• 默认遍历顺序问题：Outlook文件夹Items集合默认按接收时间从早到晚排序，无筛选时会优先处理最早的历史邮件

Sub DownloadDailyAttachment()
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim olfolder As Outlook.MAPIFolder
    Dim olItem As Object
    Dim Mailitem As Outlook.Mailitem
    Dim olAtt As Outlook.Attachment
    ' 配置项，根据实际情况修改
    Const savePath As String = "C:\你的指定保存文件夹路径" ' 替换为本地保存附件的绝对路径，例如C:\Work\DailyReport
    Const targetFolderName As String = "你的目标邮件文件夹名" ' 替换为邮件所在的文件夹名称
    Dim todayDate As Date
    todayDate = Date
    
    Set olApp = New Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    ' 定位目标邮件文件夹
    Set olfolder = olNS.GetDefaultFolder(olFolderInbox).Parent.Folders(targetFolderName)
    
    ' 按接收时间降序排序，优先处理最新邮件
    olfolder.Items.Sort "[ReceivedTime]", True
    
    For Each olItem In olfolder.Items
        ' 仅处理邮件类对象
        If olItem.Class = olMail Then
            Set Mailitem = olItem
            ' 判断邮件接收日期是否为当日
            If DateValue(Mailitem.ReceivedTime) = todayDate Then
                ' 遍历附件保存
                For Each olAtt In Mailitem.Attachments
                    ' 跳过邮件签名内嵌的图片类非实体附件，不需要可删除该判断
                    If olAtt.Type = olByValue Then
                        olAtt.SaveAsFile savePath & "\" & Format(todayDate, "yyyy-mm-dd") & "_" & olAtt.FileName
                    End If
                Next olAtt
                ' 若每日仅1封目标邮件，处理完直接退出循环提升效率
                Exit For
            End If
        End If
    Next olItem
    
    ' 释放COM对象
    Set olAtt = Nothing
    Set Mailitem = Nothing
    Set olfolder = Nothing
    Set olNS = Nothing
    Set olApp = Nothing
End Sub

• 将代码中savePath常量替换为本地存储附件的实际文件夹绝对路径
• 将targetFolderName常量替换为目标邮件所在的文件夹名称
• 如果需要保存邮件内嵌的图片附件，删除If olAtt.Type = olByValue Then及对应的End If判断即可
• 如果需要精准匹配特定发件人/主题的邮件，可在日期判断同级位置增加筛选条件，例如补充And Mailitem.SenderEmailAddress = "系统通知发件人邮箱"、And Mailitem.Subject = "每日报表"，避免误存当日其他邮件的附件
• 可配合Windows任务计划程序，设置每日固定时间触发该宏运行，实现完全自动化下载

内容的提问来源于stack exchange，提问作者user16492266