Finding the end of the body of an Outlook Email


New Member
Nov 4, 2019
I want to paste two ranges into an Outlook email.

I can create the email, filter for the range, copy and paste the range.

The problem is with where the second range pastes.

In the first three emails, everything works correctly. Then, the code does not correctly find the end of the message to paste the second range.

Is there a better way to find the end of the message?

I commented out a --->PROBLEM HERE<---- to highlight where I think the problem is.

The code will cycle through each value in an array, possibly up to 30 times and generate 30 emails.

Thanks in advance.

FYI, I know enough about VBA to tinker and cobble together pieces of code for my own uses. I in no way profess to know the best way to do something.

'This is the code I want to execute with each value in the arrayFor i = 1 To arr.Count

'Sort by Consultant
    With SortRnge2
        .AutoFilter Field:=6, Criteria1:=Array("3", _
            "-4142", "44", "6"), Operator:=xlFilterValues
        .AutoFilter Field:=ConsultantColumn, Criteria1:=arr(i), Operator:=xlFilterValues
    End With
   Application.CutCopyMode = False

'Send to Email
'Set Variables
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim Outlook As Object
    Dim newEmail As Object
    Dim xInspect As Object
    Dim pageEditor As Object
    Dim OutAccount As Outlook.Account

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)

'Specifying the send account as account [URL=]#2[/URL] 
        Set OutAccount = OutApp.Session.Accounts.Item(2)

'Create email
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = Date & " outstanding items for " & arr(i)
        .Body = "XX," & vbCrLf & vbCrLf & "These are your outstanding items for today" & vbCrLf & vbCrLf & "RFIs:" & vbCrLf & vbCrLf
        .SendUsingAccount = OutAccount
    'I'm not sure what most of this code for Outlook does as I copied it from a YouTube video. It seems to mostly do what I need.
        Set xInspect = OutMail.GetInspector
        Set pageEditor = xInspect.WordEditor
    'Copy range after filter
    'I think this code is finding the end of the body to know where to paste the first range
        pageEditor.Application.Selection.Start = Len(.Body)
        pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
        pageEditor.Application.Selection.PasteAndFormat (wdFormatOriginalFormatting)
    'Adding text between the tables
        pageEditor.Application.Selection = vbCrLf & vbCrLf & "Submittals:" & vbCrLf & vbCrLf
    'For the sake of simplicity, this code is only copy/pasting _
    the first range. In the real application, another filter will be used to create this second range. Similar code will be used _
    Sheets("RFIs Blank").SortRnge2.SpecialCells(xlCellTypeVisible).Copy to create the second range.
    'Copy the second range
        Sheets("RFIs Blank").SortRnge2.SpecialCells(xlCellTypeVisible).Copy
    'I reused the code from above to find the end of the body to paste the second range.
    '--->THE PROBLEM IS HERE<---, I THINK. This is where I paste the second range.
    'I think there is a problem with how this code finds the end of the body to paste the second range. I think that's what's creating the nested table.
        pageEditor.Application.Selection.Start = Len(.Body)

'   MsgBox pageEditor.Application.Selection.Start-->I was using this to see how what number it gave and make sure it does give the _
number of the last character. Yes, I did count them one by one.
        'Using the line below resulted in the second range being pasted as a nested table
        'pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start

        pageEditor.Application.Selection.PasteAndFormat (wdFormatOriginalFormatting)

'At this point, the second range is pasted in the incorrect place, pasted over the 1st range pasted (except for the first line). It also replaced the text below the first pasted range.

    Set pageEditor = Nothing
    Set xInspect = Nothing
    Set newEmail = Nothing
    Set OutApp = Nothing
    'Set newEmail = Nothing
    'Set Outlook = Nothing
End With

'Set OutMail = Nothing
'Set Outlook = Nothing
Set OutAccount = Nothing

Some videos you may like

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number


MrExcel MVP
Mar 10, 2004
To go to the end of the email...

    pageEditor.Application.Selection.EndKey Unit:=6 'wdStory

To enter a carriage return...


Hope this helps!


New Member
Nov 4, 2019
Domenic, thanks so much! I've been working on this code for about 5 months off and on to make one of my most tedious tasks easier. This was the last part for me to figure out. It's going to take 90 minute's work and turn it into 20 minutes. Thanks again!

Watch MrExcel Video

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back