將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