如何实现outlook指定文件夹中的邮件附件全部下载并按日期归类到不同文件夹中？

雪夜2010

各位大神，我碰到一个有问题，需要您帮忙给个建议。
问题如下：我用VBA已经实现了读取outlook指定文件夹“For Download”中的邮件的附件，并全部下载将其保存在桌面新建的“Email Attachment Temp”文件夹中（这是第一步功能）。


但是我想进一步让这些文件能根据不同的接收日期放到不同的子文件夹中。每个子文件夹都以接收日期来命名，同一天的邮件的附件都放在一个子文件夹中（这是第二步功能）。例如，子文件夹“2017-11-08”中存放的都是2017年11月8号收到的邮件的附件。


请各位大神帮我看看，我应该怎么修改我的VBA代码才可以实现这个指令。谢谢您的帮助。O(∩_∩)O哈哈~

这是我已经完成的代码，经过测试，可以实现第一步功能，但是第二步功能还无法实现。┭┮﹏┭┮
'将For Download中的附件全部保存
Sub Savetheattachment1()
    Dim olApp As New Outlook.Application
    Dim nmsName As Outlook.NameSpace
    Dim vItem As Object
    Set nmsName = olApp.GetNamespace("MAPI")
    Set myFolder = nmsName.GetDefaultFolder(olFolderInbox)
    Set fldFolder = myFolder.Folders("For Download")
    dd = "C:\Users\Public\Desktop\Email Attachment Temp"
    If Dir(dd, vbDirectory) = "" Then MkDir dd
    '若无C:\Email Attachment Temp 文件夹则新建该文件夹
    For Each vItem In fldFolder.Items
    '对fldFolder里的每一封邮件进行循环
        For Each att In vItem.Attachments
        '对每一封带附件的邮件
        fn = "C:\Users\Public\Desktop\Email Attachment Temp\" & att.FileName
        'fn为路径+附件名
        n = 1
        Do Until Dir(fn) = ""
        '如果为空，说明该路径下没有该文件
        fn = "C:\Users\Public\Desktop\Email Attachment Temp\ " & n & "_" & att.FileName
        '有该文件名则重命名前面加数字
        n = n + 1
        Loop
        att.SaveAsFile fn
        '附件存到C:\Email Attachment Temp中
        Next
    Next
    Set fldFolder = Nothing
    Set nmsName = Nothing
    MsgBox "已导出全部附件到“C:\Users\Public\Desktop\Email Attachment Temp”，请查看。"
End Sub

闻启学

  dd = "C:\Users\Public\Desktop\Email Attachment Temp" 修改DD 就行

dd= "C:\Users\Public\Desktop\Email Attachment Temp" &　ｔｏｄａｙ（）
但是你要判断是否已经建立这个日期的 文件夹

雪夜2010

闻启学 发表于 2017-11-9 22:50
dd = "C:%users\Public\Desktop\Email Attachment Temp" 修改DD 就行

dd= "C:%users\Public\Desktop\ ...

我试了你说的这一句，但是运行不了。我想问一下，如何用VBA获取邮件的收件时间呢？

lidaozhuang

第二步实现可以分为下面几个步骤去实现：
1.获取邮件的接受或发送时间作为文件夹命名标准
2.每个附件要保存的时候都要先判断该日期文件夹是否存在
3.存在直接保存到文件中，不存在创建再保存到文件中。
PS：需要注意Windows下文件命名的规范！

闻启学

QQ 联系我 417149126