Question

我有一个VBA脚本，可将传入的Outlook电子邮件提取到txt个文件中。这是代码：

 ' General Declarations
Option Explicit

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

Sub Export_MailasMSG(item As Outlook.MailItem)
' 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 strExportFolder As String: strExportFolder = "C:\OutlookEmails\"
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

    ' If the currently selected item is a mail item we can proceed
    If TypeOf item Is Outlook.MailItem Then
        ' Format the file name
        strReceivedTime = item.ReceivedTime
        strSubject = item.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"
        item.SaveAs strExportPath, olSaveAsTxt
        ' MsgBox ("Email saved to: " & strExportPath)
    Else
        ' This is not an email item.
    End If



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

End Sub

我得到的txt文件如下：

From:   Name Surname <email@address.com
Sent:   mercoledì 17 gennaio 2018 12:16
To: email@email.com
Subject:    subject here

BODY HERE

我是否可以仅提取邮件正文，而不包含from，sent，to和subject行？如果是这样，我怎么能实现呢？我不知道VBA编程。

我已尝试将此行"item.SaveAs strExportPath, olSaveAsTxt"更改为" item.Body.SaveAs strExportPath, olSaveAsTxt"，但没有运气。

Answer 1

保存电子邮件正文的最简单方法见示例

Option Explicit
Private Sub Example()
    Dim FSO As New FileSystemObject
    Dim TS As TextStream
    Dim olMsg As Outlook.mailitem

    Set olMsg = ActiveExplorer.Selection.Item(1)
    Set TS = FSO.OpenTextFile("C:\Temp\Email.txt", ForAppending, True)
        TS.Write (olMsg.Body)
        TS.Close

End Sub

See MSDN TextStream Object

仅将电子邮件正文提取到文件

1 个答案: