CODEWITHSUNDEEP
vbaoutlook
mickmickmick
mickmickmick

Reputation: 337

Extracting only email body to file

I have a VBA script that extracts incoming outlook email into txt files. Here's the code:

 ' 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

The txt files I get are as follows:

From:   Name Surname <[email protected]
Sent:   mercoledì 17 gennaio 2018 12:16
To: [email protected]
Subject:    subject here

BODY HERE

Can I extract only the mail body, without the from, sent, to and subject lines? If so, how can I achieve that? I don't know VBA programming.

I've tried changing this line "item.SaveAs strExportPath, olSaveAsTxt" to " item.Body.SaveAs strExportPath, olSaveAsTxt" but with no luck.

Upvotes: 1

Views: 3670

Answers (1)

0m3r
0m3r

Reputation: 12499

The simplest way to save just Email Body see example

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

Upvotes: 2

Related Questions