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 Documents文件夹，但不会保存到相应的每日文件夹中。需要做出哪些修改。我现在不确定我必须改变什么。感谢您的帮助。

Answer 1

您似乎错过了文件名和最后一个文件夹之间的短划线。

在& "\"后面添加strFolder = "C:\IT Documents\" & daymonthyr & strNewFolder后，它对我有效。

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

1 个答案: