Question

我尝试将Outlook邮件保存为.txt格式的系统文件夹。运行宏后，我无法在系统文件夹中看到任何文件。

我在I：\ Documents文件夹中没有得到任何结果。

Sub SaveSelectedMailAsTxtFile()
  Const OLTXT = 0
  Dim currentExplorer As Explorer
  Dim Selection As Selection
  Dim oMail As Outlook.MailItem
  Dim obj As Object
  Dim sPath As String
  Dim dtDate As Date
  Dim sName As String

  Set currentExplorer = Application.ActiveExplorer
  Set Selection = currentExplorer.Selection

  For Each obj In Selection
    Set oMail = obj
    sName = oMail.Subject
    ReplaceCharsForFileName sName, "_"

    dtDate = oMail.ReceivedTime
    sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
      vbUseSystem) & Format(dtDate, "-hhnnss", _
      vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".txt"

    oMail.SaveAs "I:\Documents" & sName & ".txt", OLTXT
  Next

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

Answer 1

' General Declarations
Option Explicit

' Public declarations
Public Enum olSaveAsTypeEnum
  olSaveAsTxt = 0
  olSaveAsRTF = 1
  olSaveAsMsg = 3
End Enum

Sub Export_MailasMSG()
' Routine will take all selected mails and export them as .MSG files to the
' directory defined by
' Error Handling
On Error Resume Next

' Varaiable Declarations
Dim objItem As Outlook.MailItem
Dim strExportFolder As String: strExportFolder = "I:\Documents\"
Dim strExportFileName As String
Dim strExportPath As String
Dim strReceivedTime As String
Dim strSubject As String
Dim objRegex As Object

' Initiate regex search
Set objRegex = CreateObject("VBScript.RegExp")
With objRegex
.Pattern = "(\s|\\|/|<|>|\|\|\?|:)"
.Global = True
.IgnoreCase = True
End With

' Check if any objects are selected.
If Application.ActiveExplorer.Selection.Count = 0 Then
   MsgBox ("No item has been selected.")
Else
    ' Cycle all selected objects.
    For Each objItem In Application.ActiveExplorer.Selection
        ' If the currently selected item is a mail item we can proceed
        If TypeOf objItem Is Outlook.MailItem Then
            ' Format the file name
            strReceivedTime = objItem.ReceivedTime
            strSubject = objItem.Subject
            strExportFileName = Format(strReceivedTime, "yyyymmdd", vbUseSystemDayOfWeek, _
                    vbUseSystem) & Format(strReceivedTime, "-hhnnss", _
                    vbUseSystemDayOfWeek, vbUseSystem) & "-" & strSubject
            strExportFileName = objRegex.Replace(strExportFileName, "_")
            ' Export to the predefined folder.
            strExportPath = strExportFolder & strExportFileName & ".txt"
            objItem.SaveAs strExportPath, olSaveAsTxt
            MsgBox ("Email saved to: " & strExportPath)
        Else
            ' This is not an email item.
        End If
    Next 'objItem
End If



' Clear routine memory
Set objItem = Nothing
Set objRegex = Nothing

End Sub

这是我用于此的代码。它将收集所有选定的电子邮件，并将它们作为txt文件导出到strExportFolder指定的文件夹中。它还会对选择了多少项以及它们是否为电子邮件进行一些验证。我使用枚举olSaveAsTypeEnum在msg和txt之间进行选择。我通常使用txt但是对于你的情况我能够很容易地将它改为txt因为我有枚举设置。我用regex replace命令替换sub ReplaceCharsForFileName。

您应该能够插入日期操作代码以满足您的需求。

编辑：我已更新代码以包含您创建时间戳的方法。我在一系列电子邮件中尝试了这个，我可以在选择大约7后看到所有的txt文件。如果这仍然无效，我需要查看一些电子邮件的主题和时间以及文件名那些你＆＃34;见＆＃34;。上面的代码现在适用于我，因为我相信你的意图。

由于我没有您的源数据，我将无法进行太多测试。

Answer 2

"I:\Documents" & sName

将保存到

I:\Documents20140722-sName.txt

所以添加目录char：

oMail.SaveAs "I:\Documents\" & sName & ".txt", OLTXT

将Outlook邮件保存到系统文件夹中的单个.txt文件中

2 个答案: