如果文件名是重复的,请每天保存电子邮件

时间:2015-05-11 16:03:26

标签: vba outlook outlook-vba

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

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

这样的事情是否适用于我想要做的事情,或者将时间附加到文件名会更好吗?

1 个答案:

答案 0 :(得分:0)

使用Date Time Seconds&amp;你可以做的主题

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