下载具有相同名称的附件而不会覆盖 [英] Download attachments with same name without overwriting

问题描述

下面是从Outlook中的邮件中下载附件的脚本.

Below is the script to download an attachment from mails in 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

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

It downloads and stores in the path which is mentioned in my code only when attachment has different name.

例如，我收到的邮件附件为"List.csv".同名，我大约收到了10封邮件.

For example, I received mail with attachment as 'List.csv'. With same name I received mail around 10 times.

但是路径中仅保存了一个文件(最新的一个).

But only one file (most recent one) got saved in the path.

最适合我的最终代码.

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

推荐答案

您将覆盖所有具有相同名称的现有文件.

You are just overwritting any existing file having the same name.

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

A very simple solution is to append the current date/time to the file name prior to save it.

要仅下载最近30天的附件，请在该过程的开头添加一个检查，以比较邮件的ReceivedTime与30天之前的日期，如果接收的时间较短，则退出该过程.

To download attachments from the last 30 days only, add a check at the beginning of the procedure to compare the Mail's ReceivedTime with the date 30 days ago, and exit the procedure if received time is lower.

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的检查位置不正确，理想情况下，应在调用过程中执行此操作.

But the check on ReceivedTime is not well placed, you should ideally do this this on the calling procedure.

这篇关于下载具有相同名称的附件而不会覆盖的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！