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

Question

下面是从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 

Answer 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检查是没有得到很好的放置，你最好应该做这个的调用过程。