如果文件名重复，则每天保存电子邮件

Question

我正在编写一个每天保存电子邮件的宏。我只是想到了一个可能发生的情况。我有时会收到发件人发来的主题相同的邮件，但每封邮件的内容都不一样。我想要一组语句来处理这个问题。也许让它说它是一个副本，或者甚至可以将时间附加到文件名。这是我现在拥有的代码。

Public Sub SaveMsgs(Item As Outlook.MailItem)
 Dim sPath As String
 Dim dtDate As Date
 Dim sName As String
 Dim enviro As String
 Dim sSender As String
 Dim strFolder As String
 Dim strNewFolder As String
 Dim save_to_folder As String
 Dim strMyPath as String
 Dim intCount as Integer
 Dim 

 enviro = CStr(Environ("USERPROFILE"))

 sName = Item.Subject
 ReplaceCharsForFileName sName, "_"

 sSender = Item.Sender

 dtDate = Item.ReceivedTime
 sName = sSender & " - " & sName & ".msg"

 strNewFolder = Format(Date, "mm-dd-yyyy")
 strFolder = "C:\IT Documents\" & strNewFolder & "\"

 If Len(Dir(strFolder, vbDirectory)) = 0 Then
   MkDir (strFolder)
 End If

 save_to_folder = strFolder

 Item.SaveAs save_to_folder & sName, olMSG
End Sub

Private Sub ReplaceCharsForFileName(sName As String, _
     sChr As String _)

 sName = Replace(sName, "/", sChr)
 sName = Replace(sName, "\", sChr)
 sName = Replace(sName, ":", sChr)
 sName = Replace(sName, "?", sChr)
 sName = Replace(sName, Chr(34), sChr)
 sName = Replace(sName, "<", sChr)
 sName = Replace(sName, ">", sChr)
 sName = Replace(sName, "|", sChr)
End Sub

这是我考虑添加的代码。

Do While True 
  strMyPath = strFolder & sName 
  If objFSO>FileExists(strMyPath) Then 
    intCount = intCount + 1 
    sName = Copy (" & intCount & ") 
  Else Exit Do 
  End If 
Loop

这样的事情对我正在尝试做的事情有用吗，还是将时间附加到文件名会更好？

Answer 1

要保存日期时间秒数和主题，您可以这样做

 sName = Format(dtDate, "MM-DD-YYYY", vbUseSystemDayOfWeek, _
                    vbUseSystem) & Format(dtDate, "-hhnnss", _
                    vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"

如果文件名重复，则每天保存电子邮件

Save emails daily incorporating if filename are duplicates

outlook

vba