Combine .Body = Range("Range1") and after .HTMLBody ="<br><br>" & rangetoHTML(Range("Range2"))

[drom]

Hi and Thanks in advance!

I am using:

History | Ron de Bruin

Welcome to https://www.rondebruin.nl

www.rondebruin.nl

in order to paste a range in outlook body (Works Perfect)

But I would like to add a combined range before I use:

 With OutMail
 .Display 'Nice to see step by step Pasted info
 .Subject = "RRF for Vendor Sourcing"
'if I use:
'Range("RangeXXX") 'which Is a combined range were I have usually many lines at present 10
.Body = Range("Range1")
' I get the desired lines on Outlook Body very nice
'Then I would like to paste the selected range or Range2 on the last empty line on Outlooks Body (keeping the pasted info
'I am trying to use
.HTMLBody ="<br><br><br>"   & rangetoHTML(Selection)& "<br><br><br>"
'But I lost the pasted info using .body=range("Range1")

end with

SO I woulld like to combine
.body = Range("Range1")
.HTMLBody ="<br><br>" & rangetoHTML(Range("Range2"))
Keeping on Outlooks body both ranges

• Range1 (the 10 lines)
• a few empty lines & "<br><br><br>"
• Range2

I mean I would like to use first
.Body = Range("Range1")
and after this info the pasted Outlloks Body last empty line, paste a range using:
.HTMLBody ="<br><br><br>" & rangetoHTML(Selection) & "<br><br><br>"


If U use:
.HTMLBod

y = rangetoHTML(range("Range1") & "<br><br><br>" & rangetoHTML(range("Range2")
Range1 does not keep the 10 lines in Outlook, shows only a huge line

Thanks again

 

[Colo]

Hi, dorm,
I've never used Ron de Bruin's one as yet, but I had a look at his code.
It doesn't work for Multiple selected ranges. For letting his code do what you want, Code in the "Function RangetoHTML" should be modified. Assume you would select 2 ranges before running his code. The following amended function would add some empty lines between Range1 and Range2. To change how many empty lines you need, just change the following constant.

Const EmptyLinesCount As Long = 3 'between Range1 and Range2

Just replace Function RangetoHTML, Sub Mail_Selection_Range_Outlook_Body can be used as it is.

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
' Changed by Colo 14-July-2022 for drom from MrExcel
' Multiple selected ranges
    Const EmptyLinesCount As Long = 3    'between Range1 and Range2
    Dim r As Range
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    Dim l As Long

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    Set TempWB = Workbooks.Add(1)
    l = 1    ' for the first area

    For Each r In rng.Areas
        'Copy the range and create a new workbook to past the data in
        r.Copy
        With TempWB.Sheets(1)
            .Cells(l, 1).PasteSpecial Paste:=8
            .Cells(l, 1).PasteSpecial xlPasteValues, , False, False
            .Cells(l, 1).PasteSpecial xlPasteFormats, , False, False
            .Cells(l, 1).Select
            Application.CutCopyMode = False
            On Error Resume Next
            .DrawingObjects.Visible = True
            .DrawingObjects.Delete
            On Error GoTo 0
            If l = 1 Then flg = True
            l = .Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
            If flg Then
                l = l + EmptyLinesCount
                flg = False
            End If

        End With
    Next

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

 

[drom]

Does the job as well

    With OutMail
        .Display
        .Body = ""   'Not necessary but...
        .Body = Range("Range1") 
        'Before
        .HtmlBody =.HtmlBody  & "<br><br>" &  RangetoHTML(Range("Range2") ) & "<br><br>" 
        ''After
        '.Body = ""
        '.Body = Range("Range1")         
        '.HtmlBody = "<br><br>" & .HtmlBody & "<br><br>" & RangetoHTML(Range("Range2")) & "<br><br><br>"
        .Save
        .Send
    End With