asked on

Export Email Body to Excel 2013

I would like to export the email body of a bunch of emails in a subfolder located in my outlook 2013 to excel 2013.

So far I have this coding setup in a module but it isnt transferring all of the email body to the excel sheet.

How can i get outlook to export the entire email body to an excel row ?

Furthermore what do i need to add to coding to create the excel sheet if it doesnt exist ?

The Excel output looks like this:

The Email looks like this:

 
Sub ExportToExcel()

On Error GoTo ErrHandler
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim strSheet As String
Dim strPath As String
Dim intRowCounter As Integer
Dim intColumnCounter As Integer
Dim msg As Outlook.MailItem
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder

Dim itm As Object
strSheet = "Emails.xlsx"
strPath = "C:\excel\"
strSheet = strPath & strSheet


Debug.Print strSheet
' Select export folder
Set nms = Application.GetNamespace("MAPI")
Set fld = nms.PickFolder

' Handle potential errors with Select Folder dialog box.
If fld Is Nothing Then
MsgBox "There are no mail messages to export", vbOKOnly, _
"Error"

Exit Sub
ElseIf fld.DefaultItemType <> olMailItem Then
MsgBox "There are no mail messages to export", vbOKOnly, _
"Error"

Exit Sub

ElseIf fld.Items.Count = 0 Then
MsgBox "There are no mail messages to export", vbOKOnly, _
"Error"
Exit Sub

End If
' Open and activate Excel workbook.
Set appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Open (strSheet)

Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets(1)
wks.Activate
appExcel.Application.Visible = True

' Copy field items in mail folder.
For Each itm In fld.Items
intColumnCounter = 1
Set msg = itm
intRowCounter = intRowCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.To
intColumnCounter = intColumnCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.SenderEmailAddress
intColumnCounter = intColumnCounter + 1

Set rng = wks.Cells(intRowCounter, intColumnCounter)


rng.Value = msg.Subject
intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.SentOn
intColumnCounter = intColumnCounter + 1
Set rng = wks.Cells(intRowCounter, intColumnCounter)
rng.Value = msg.ReceivedTime

Next itm
Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set msg = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing

Exit Sub

ErrHandler:  If Err.Number = 1004 Then
MsgBox strSheet & " doesn't exist", vbOKOnly, _
"Error"

Else

MsgBox Err.Number & "; Description: ", vbOKOnly, _
"Error"

End If

Set appExcel = Nothing
Set wkb = Nothing
Set wks = Nothing
Set rng = Nothing
Set msg = Nothing
Set nms = Nothing
Set fld = Nothing
Set itm = Nothing
End Sub

Open in new window

Karl Timmermans (Outlook MVP 2012-2018)

How can i get outlook to export the entire email body to an excel row ?

Like any other field - i.e. to use your existing code sample for sake of simplicity (also requires adding a column for that field which does not currently exist

rng.value = msg.body

Open in new window

Furthermore what do i need to add to coding to create the excel sheet if it doesnt exist ?

Again, keeping this as simple as possible based on your code

wks.Add(After:=wks(wks.Count)).Name = "new_sheet_name"

Open in new window

(Have simply answered the explicit questions asked as opposed to critiquing your VBA code sample in detail - will leave that to Excel VBA experts. Just based on your code, (1) assumption is that worksheet is always #1 in the workbook (2) you are overwriting the contents of the existing worksheet without first clearing anything, (3) unnecessarily setting the Excel "Range" etc etc (to name but 3 things)).

Troy Graham

ASKER

Hi Karl,

Thanks for your fast reply on this but i seem to be having some trouble with your suggestion as I am still fairly new to VBA Coding.

the msg.body code you suggested works great but is there a way I can trim the message body to only output up to the word Box.

e.g. Message Body looks like this

GoFormz was unable to save the form "790305 - 133768 - CALTEX BURNSIDE" to Box

______________________________________________________________________
This email has been scanned by the Symantec Email Security.cloud service.
For more information please visit http://www.symanteccloud.com ______________________________________________________________________

I only want to export the first line "GoFormz was unable to save the form "790305 - 133768 - CALTEX BURNSIDE" to Box"

How can this be done.

Secondly I am little unsure where to put the wks.Add coding. Does it replace Line 17-20?

Thanks
Troy

ASKER CERTIFIED SOLUTION

Karl Timmermans (Outlook MVP 2012-2018)

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial