下载具有相同名称的附件而不覆盖

时间:2016-09-06 12:33:13

标签: vba outlook

以下是从Outlook中的邮件下载附件的脚本。

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
    Dim oAttachment As Outlook.Attachment
    Dim sSaveFolder As String
    Dim dateFormat

    dateFormat = Format(Now, "yyyy-mm-dd")
    sSaveFolder = "c:\My\temp\"
    For Each oAttachment In MItem.Attachments
        oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
    Next
End Sub

只有当附件具有不同的名称时,它才会下载并存储在我的代码中提到的路径中。

例如,我收到附件为“List.csv'”的邮件。我用同样的名字收到了10次邮件。

但是只有一个文件(最近一个)被保存在路径中。

最终代码对我有用。

Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
    Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim dt30daysAgo As Date

    dt30daysAgo = DateAdd("d", -30, Now)
    saveFolder = "c:\My\temp"

    For Each objAtt In itm.Attachments
        If itm.ReceivedTime > dt30daysAgo Then
            If objAtt.FileName <> "list.csv" Then
                objAtt.SaveAsFile saveFolder & "\" & objAtt.FileName
            Else
                objAtt.SaveAsFile saveFolder & "\" & itm.Subject & objAtt.FileName
            End If
        End If
    Next
End Sub

1 个答案:

答案 0 :(得分:1)

您只是覆盖任何具有相同名称的现有文件。

一个非常简单的解决方案是在保存之前将当前日期/时间附加到文件名。

要仅过去30天内下载附件,请在程序开头添加一项检查,以便将邮件ReceivedTime与30天前的日期进行比较,如果收到的时间是低。

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
    Dim oAttachment As Outlook.Attachment
    Dim sSaveFolder As String
    Dim dt30daysAgo As Date

    dt30daysAgo = DateAdd("d", 30, Now)

    If MItem.ReceivedTime < dt30daysAgo Then Exit Sub

    sSaveFolder = "c:\My\temp\"
    For Each oAttachment In MItem.Attachments
        oAttachment.SaveAsFile sSaveFolder & Format(Now, "YYYY-MM-DD_hh-nn-ss") & oAttachment.DisplayName
    Next
End Sub

但对ReceivedTime的检查并不合适,理想情况下你应该在调用程序中执行此操作。

相关问题