VBA Mailing Code compresses email content

[Pobek]

The code below sends a mail in outlook from an excel model (composed in cell H3). The problem is the mail content in h3 is separated out in different paragraphs that I would like to be carried over to the actual email body in outlook. Unfortunately when the email comes out, it is all compressed into one long sting without paragraphs or spaces demarcated.

Can someone suggest what tweaks could work: (please note that the ".htmlbody" was adopted in order to maintain the signature logo in the email)



The code:

Sub DelaySendingEmail()

Dim Msg As String
Dim olApp As Object
Dim olEmail As Object
Dim SendAt As String
Dim SendTo As String
Dim Subj As String
Dim signature As String

''''''''''''''''''
''''''''''''''''''
For i = Range("b1").Value To Range("d1").Value
''''''''''''''''''
''''''''''''''''''


Range("recipient").Value = Cells(10 + i, 1).Value
Range("e3").Value = Cells(10 + i, 7).Value
subje = Range("h2").Value
mes = Range("h3").Value


SendTo = Range("recipient").Value
Subj = subje
Msg = mes


On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err = 429 Then
Err.Clear
Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
olApp.Session.Logon

Set olEmail = olApp.CreateItem(olMailItem)

''
With olEmail
.Display
End With
signature = olEmail.HTMLbody
''

With olEmail
' .DeferredDeliveryTime = SendAt
.To = SendTo
.Subject = Subj
.HTMLbody = Msg & vbNewLine & signature
.Send
End With

olApp.Session.Logoff

Set olApp = Nothing
Set olEmail = Nothing




Next i
End Sub

 

[daverunt]

See if this post is helpful.

VBA email format - html vs. plain

hi, I am using vba to create an email from the UserForm. One of my TextBoxes (called "WorkInstructionsTX") in the form has multiline. How can I create an email so the information from this particular TextBox is multiline in an email body as well? I am using the below code: .htmlbody = "Hi " &...

www.mrexcel.com

 

[daverunt]

See if this post is helpful.

VBA email format - html vs. plain

hi, I am using vba to create an email from the UserForm. One of my TextBoxes (called "WorkInstructionsTX") in the form has multiline. How can I create an email so the information from this particular TextBox is multiline in an email body as well? I am using the below code: .htmlbody = "Hi " &...

www.mrexcel.com

There's also the RangetoHTML function on Ron De Bruins site that can be used to copy the range to the Outlook Body, which may be a better option. It also keeps any formatting/wordwrapping

Home | Ron de Bruin Excel Automation

Welcome to https://www.rondebruin.nl

www.rondebruin.nl

 

[Pobek]

See if this post is helpful.

VBA email format - html vs. plain

hi, I am using vba to create an email from the UserForm. One of my TextBoxes (called "WorkInstructionsTX") in the form has multiline. How can I create an email so the information from this particular TextBox is multiline in an email body as well? I am using the below code: .htmlbody = "Hi " &...

www.mrexcel.com

Thanks for this but I am really struggling to tweak the code... mainly because I think he is composing his mail in the vba code. Mine is already composed in the excel cell with paragraphs, space format and all. All i need is to take that code to outlook as is in the excel. I was able to do it with the same code using ".body" as opposed to ".htmlbody", but as soon as i do that, it sends the email fine but without my logo appearing in my signature; effectively solving the format issue but creating a signature lggo disappearing one.

Any suggestions?

 

[daverunt]

Hi,

See if this works.

The code in the first link I posted takes the content of the cell replaces the CR/LF characters for HTML break tags < br >.
As the Outlook mail format is being rendered in HTML it should display your separate lines.
There will be an extra break tag added where a blank line occurs in the cell content so this will give you the space between paragraphs in the mail

It won't copy any text formatting in the cell across.

   mes = Range("H3").Value
   mes = Replace(mes, Chr(10), "<br>")
   mes = Replace(mes, Chr(13), "<br>")

Msg = mes
.HTMLBody = Msg & vbNewLine & signature

 

[daverunt]

If you need the text formatting such as font/colour from the sheet don't use the code above just make the changes to the following bits of your code.

Copy and paste the RangetoHTML function into the same module as the mail macro after End Sub

Dim mes As Range
Set mes = ActiveSheet.Range("H3")


Msg = mes ---------------Not required. Why not change mes to Msg throughout

.HTMLBody = RangetoHTML(mes) & "<br>" & Signature




Function RangetoHTML(rng As Range)

' Changed by Ron de Bruin 28-Oct-2006 ' Working in Office 2000-2016

    Dim fso As Object
Dim ts As Object
Dim TempFile As String
    Dim TempWB As Workbook

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

    'Copy the range and create a new workbook to past the data in

    rng.Copy

    Set TempWB = Workbooks.Add(1)

    With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False

On Error Resume Next

.DrawingObjects.Visible = True
.DrawingObjects.Delete

On Error GoTo 0

End With
    '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

 

[Pobek]

Hi,

See if this works.

The code in the first link I posted takes the content of the cell replaces the CR/LF characters for HTML break tags < br >.
As the Outlook mail format is being rendered in HTML it should display your separate lines.
There will be an extra break tag added where a blank line occurs in the cell content so this will give you the space between paragraphs in the mail

It won't copy any text formatting in the cell across.

   mes = Range("H3").Value
   mes = Replace(mes, Chr(10), "<br>")
   mes = Replace(mes, Chr(13), "<br>")

Msg = mes
.HTMLBody = Msg & vbNewLine & signature

Brilliant! This works perfect ... Thanks a lot.

 

[Pobek]

If you need the text formatting such as font/colour from the sheet don't use the code above just make the changes to the following bits of your code.

Copy and paste the RangetoHTML function into the same module as the mail macro after End Sub

Dim mes As Range
Set mes = ActiveSheet.Range("H3")


Msg = mes ---------------Not required. Why not change mes to Msg throughout

.HTMLBody = RangetoHTML(mes) & "<br>" & Signature




Function RangetoHTML(rng As Range)

' Changed by Ron de Bruin 28-Oct-2006 ' Working in Office 2000-2016

    Dim fso As Object
Dim ts As Object
Dim TempFile As String
    Dim TempWB As Workbook

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

    'Copy the range and create a new workbook to past the data in

    rng.Copy

    Set TempWB = Workbooks.Add(1)

    With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False

On Error Resume Next

.DrawingObjects.Visible = True
.DrawingObjects.Delete

On Error GoTo 0

End With
    '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



However I tried this just to know it works and in case I need it next time. It didnt saying that nothing should be pasted after end sub ... I know I have done something wrong even though I'm sure I have followed your instruction. This bit of the code is in red :

    With TempWB.PublishObjects.Add( _

SourceType:=xlSourceRange, _

Filename:=TempFile, _

Sheet:=TempWB.Sheets(1).Name, _

Source:=TempWB.Sheets(1).UsedRange.Address, _

         HtmlType:=xlHtmlStatic)