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

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，因为我已经设置了枚举。我用正则表达式替换命令替换sub ReplaceCharsForFileName。

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

编辑：我已更新代码，以包括您创建时间戳的方法。我在一系列电子邮件上试了这个，我可以在选择大约7后看到所有的txt文件。如果这仍然不起作用，我需要查看一些电子邮件的主题和时间以及文件名你“看到”的那些。上面的代码现在适用于我，因为我相信你打算这么做。

除此之外，我无法进行太多的测试，因为我没有要使用的源数据。

Answer 2

"I:\Documents" & sName 

将保存到

I:\Documents20140722-sName.txt 

所以添加目录字符：

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