Email through Excel, text formatting (VBA)

[NewUser2]

Okay so I am having a problem. If you enter this code (below) in a VBA module you will have the desired text show up in the email body and to the desired recipients (yay). HOWEVER, I need to find a way to have my formatted text appear as it is in excel. ie bolded and underlined at certain points.

Please, any suggestions would be greatly appreciated. (if you can get it to work, maybe just paste in the new code?)

Sub CreateMail()


Dim doData1 As DataObject, doData2 As DataObject
Dim objOutlook As Object, objMail As Object
Dim rngTo As Range, rngCc As Range, rngSubject As Range
Dim rngBody1 As Range, rngBody2 As Range

Set doData1 = New DataObject
Set doData2 = New DataObject
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)


With Sheets("Sheet1")
Set rngTo = .Range("D2")
Set rngCc = .Range("D3")
Set rngSubject = .Range("H1")
End With

'This is the selection for the body of the email.
Set rngBody1 = Sheets("Sheet1").Range("A1:C10")
rngBody1.Copy
doData1.GetFromClipboard


'I unlock these if I want to add data from another sheet or a new range from the same sheet
'Set rngBody2 = Sheets("Sheet3").Range("B1")
'rngBody2.Copy
'doData2.GetFromClipboard

With objMail
.To = rngTo.Value
.CC = rngCc.Value
.Subject = rngSubject.Value
.Body = doData1.GetText(1) '(this section is locked and unlocked if I want to use a second range) & vbCrLf & doData2.GetText(1)
.Send
End With

Set doData1 = Nothing
Set doData2 = Nothing
Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngCc = Nothing
Set rngSubject = Nothing
Set rngBody1 = Nothing
Set rngBody2 = Nothing


End Sub

 

[NewUser2]

Anyone have an idea??

 

[Michael M]

Did you search this forum first ?
Here's a thread similar to yours.
You will need to use HTML tags to add the formatting

http://www.mrexcel.com/forum/excel-...-body-txt-bold-visual-basic-applications.html

 

[NewUser2]

I did search around, and setting it to <b> with .HTMLBody doesn't work for mine... As you see in my code, to get the desired cells in the body I am selecting a range which collects a table (see below), for the table I only want to headings to be bold, not all the text in the table.

I would be fine copying and pasting a picture if someone knows how to go about that... As long as my range can appear as it is in

[TABLE="width: 202"]
<colgroup><col span="2"><col></colgroup><tbody>[TR]
[TD][/TD]
[TD]Current[/TD]
[TD]Change[/TD]
[/TR]
[TR]
[TD]US[/TD]
[TD][/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]3M[/TD]
[TD]0.02[/TD]
[TD]0.01[/TD]
[/TR]
[TR]
[TD]1Y[/TD]
[TD]0.24[/TD]
[TD]0.00[/TD]
[/TR]
[TR]
[TD]2Y[/TD]
[TD]0.69[/TD]
[TD]-0.01[/TD]
[/TR]
[TR]
[TD]5Y[/TD]
[TD]1.62[/TD]
[TD]-0.01[/TD]
[/TR]
[TR]
[TD]10y[/TD]
[TD]2.13[/TD]
[TD]-0.01[/TD]
[/TR]
[TR]
[TD]30Y[/TD]
[TD]2.71[/TD]
[TD]-0.01[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Canada[/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]3M[/TD]
[TD]0.58[/TD]
[TD]0.00[/TD]
[/TR]
[TR]
[TD]1Y[/TD]
[TD]0.63[/TD]
[TD]0.00[/TD]
[/TR]
[TR]
[TD]2Y[/TD]
[TD]0.60[/TD]
[TD]0.01[/TD]
[/TR]
[TR]
[TD]5Y[/TD]
[TD]0.92[/TD]
[TD]-0.01[/TD]
[/TR]
[TR]
[TD]10y[/TD]
[TD]1.52[/TD]
[TD]-0.01[/TD]
[/TR]
[TR]
[TD]30Y[/TD]
[TD]2.17[/TD]
[TD]0.00

[/TD]
[/TR]
</tbody>[/TABLE]

 

[daverunt]

Hi,

If you use RangeToHTML with HTMLBody it will copy the range to Outlook with the Excel formatting.

I used the following to test using your code

.HTMLBody = RangetoHTML(rngBody1)

Have a play it should suit.

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
    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

 

[NewUser2]

It Worked!! Thank you!

Hi,

If you use RangeToHTML with HTMLBody it will copy the range to Outlook with the Excel formatting.

I used the following to test using your code

.HTMLBody = RangetoHTML(rngBody1)

Have a play it should suit.

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
    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