Range in Middle of the email body

Question

I am working on a Code which can get the range/selection in the middle of the email body. The below code works a bit fine for me it does not captures the desired range in th

Answer 1

Option Explicit

Sub Selection_email()
    Dim bStarted As Boolean
    Dim olApp As Object
    Dim oItem As Outlook.MailItem
    Dim olMailItm As Object
    Dim rngTo As Range
    Dim rngSubject As Range
    Dim Last As Variant
    Dim htmlString As String
    Dim beginBody, endBody As String
    Dim oOutlookApp As Outlook.Application

    Set olApp = CreateObject("Outlook.Application")
    Set olMailItm = olApp.CreateItem(0)
    Set oOutlookApp = GetObject(, "Outlook.Application")

    If Err <> 0 Then
        Set oOutlookApp = CreateObject("Outlook.Application")
        bStarted = True
    End If

    Set oItem = oOutlookApp.CreateItem(olMailItem)
    With ActiveSheet
        Set rngTo = .Range("E3")
        Last = ActiveSheet.Cells(2, 4).Value
    End With

    'create the HTML table first --
    '  this builds a string with proper HTML header info
    htmlString = RangetoHTML(ActiveSheet.Range("A1:D6"))
    'now add the email greeting to the body information
    beginBody = Left(htmlString, InStr(1, htmlString, "", vbTextCompare) + 6)
    endBody = Right(htmlString, Len(htmlString) - InStr(1, htmlString, "", vbTextCompare) + 5)
    htmlString = beginBody & _
                    "Hello,

Welcome to My World

" & _
                    endBody
    'now find the end of the table and add the signoff message
    beginBody = Left(htmlString, InStr(1, htmlString, "