将电子邮件保存到日常文件夹

Question

我正在尝试创建一个宏，它将电子邮件保存到在我的硬盘驱动器上本地创建的文件夹中。该文件夹每天通过写入的批处理文件创建。文件夹名称格式将为 mm-dd-yyyy。我的目标是将每天收到的所有电子邮件保存到相应的文件夹中。例如，今天收到的所有电子邮件都会保存到名为 05-07-2015 的文件夹中。这是我到目前为止的代码。

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

  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\" & daymonthyr & strNewFolder

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

  save_to_folder = strFolder


  'FolderCreate = "C:\IT Documents\" & Format(Now, "mm-dd-yyyy ") & "\"

  'If Not FSO.FolderExists(FolderCreate) Then
  'FSO.CreateFolder (FolderCreate)
  'End If

'set the destination path
 ' sPath = "C:\IT Documents\" & Format(Now, "mm-dd-yyyy ") & "\"
  For Each Item In Outlook.ActiveExplorer.Selection

  Debug.Print sName
  Item.SaveAs save_to_folder & sName

  Next

  Set Item = Nothing

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

到目前为止，脚本几乎运行应该是这样。电子邮件正在保存到 IT 文档文件夹，但未保存到相应的日常文件夹。需要进行哪些修改。我现在不确定我必须改变什么。提前感谢您的帮助。

Answer 1

您好像漏掉了文件名和最后一个文件夹之间的破折号。

在 strFolder = "C:\IT Documents\" & daymonthyr & strNewFolder 后面加上 & "\" 后对我有用。

将电子邮件保存到日常文件夹

Save emails to daily folders

outlook

vba