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

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后面添加& ""后，它对我有用。