Excel to Outlook Bold Text & Include Auto Signature

[Strygwyr]

Hello everyone,

I'm very new to VBA and have been trying to write my own Excel macro to auto generate a Microsoft Outlook message but I've encountered some issues. I'm struggling to have a text line in Excel (Cell 7,1 or "A7") be bold font in the Outlook message and include Outlook's automatic signature at the bottom of the message. Could someone please provide some guidance as to how I could do this?

Product: Microsoft Office Professional Plus 2013

Option Explicit
Sub Rectangle1_Click()

Dim OutApp As Object
Dim OutMail As Object
Dim signature As String
Dim strbody As String


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

strbody = Cells(3, 1).Text & vbNewLine & vbNewLine & _
Cells(5, 1).Text & vbNewLine & _
Cells(7, 1).Text & vbNewLine & _
Cells(9, 1).Text & vbNewLine & vbNewLine & _
Cells(11, 1).Text


On Error Resume Next
With OutMail
.To = Worksheets("FCDDA Data").Range("B5")
.CC = Worksheets("FCDDA Data").Range("B3") & Worksheets("FCDDA Data").Range("C3")
.BCC = ""
.Subject = Worksheets("FCDDA Data").Range("B20") & Space(1) & Worksheets("FCDDA Data").Range("B21")
.Body = strbody
.display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

End Sub


Thanks again for all the help, it is greatly appreciated!

Regards,

Strygwyr

[Kenneth Hobs]

Welcome to the forum! When pasting code, please do so between code tags. Click the # icon in the toolbar of a reply or type them (code)(/code) but replace ()'s with []'s.

Typing the code tags is like html. That is what you need to use for your problem. I suggest using .htmbody. Ron de Bruin has a routine that can convert a range to html. It is called RangeToHTML(). So, just poke what you want into a range, format to suit, and then call Ron's routine. He also shows how to add a signature. See: http://www.rondebruin.nl/win/s1/outlook/signature.htm

[Strygwyr]

Thanks for the welcome and the reply, I apologize for not correctly formatting my code. I'll paste it below in the correct format for easier reference.

Thanks for the direction. Unfortunately, I haven't had much success converting the code range to HTML, even with Ron de Bruin's help. I have also found some issue with having a text string return automatically in Bold Text format. Sorry, could you provide a bit more direction, I am very new at this. Thanks!


Option Explicit
Sub Rectangle1_Click()

Dim OutApp As Object
Dim OutMail As Object
Dim signature As String
Dim strbody As String


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

strbody = Cells(3, 1).Text & vbNewLine & vbNewLine & _
Cells(5, 1).Text & vbNewLine & _
Cells(7, 1).Text & vbNewLine & _
Cells(9, 1).Text & vbNewLine & vbNewLine & _
Cells(11, 1).Text


On Error Resume Next
With OutMail
.To = Worksheets("FCDDA Data").Range("B5")
.CC = Worksheets("FCDDA Data").Range("B3") & Worksheets("FCDDA Data").Range("C3")
.BCC = ""
.Subject = Worksheets("FCDDA Data").Range("B20") & Space(1) & Worksheets("FCDDA Data").Range("B21")
.Body = strbody
.display
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

[Kenneth Hobs]

When using html in the body in Outlook, use .htmlbody rather than .body.

I noticed that you used the range's .Text property. I find that that is best when I want to get the date as the number formatted date string. Otherwise, I use .Value2 if I know it is a string or the default .Value to get the true value for strings and numbers/dates. Concatenation will coerce number values into string values.

I show several ways here. As I said, I would make a scratch range and bold that cell in a macro or just bold the original cell manually. See the last strBody example for the most simple .htmlbody string.

To try this, run on a new workbook with a sheet1 and sheet2.

Sub Main()
Dim strBody As String

'Example dummy data
With Sheet1
.Cells(3, "A").Value2 = "Hello World! Counting down..."
.Cells(5, "A").Value = 1
.Cells(7, "A").Value = 2
.Cells(9, "A").Value = 3
.Cells(11, "A").Value = 4
End With

'Original, strBody from Sheet1 example
With Sheet1
strBody = .Cells(3, 1).Text & vbCrLf & vbCrLf & _
.Cells(5, 1).Text & vbCrLf & _
.Cells(7, 1).Text & vbCrLf & _
.Cells(9, 1).Text & vbCrLf & vbCrLf & _
.Cells(11, 1).Text
End With
MsgBox strBody

'Example scratch working data
With Sheet2
.Range("A1").Value2 = Sheet1.Range("A3").Value
'Bold Sheet2!A1 by macro
.Range("A1").Font.Bold = True
'pseudo blank line..
.Range("A3").Value = Sheet1.Range("A5").Value
.Range("A4").Value = Sheet1.Range("A7").Value
.Range("A5").Value = Sheet1.Range("A9").Value
'pseudo blank line...
.Range("A7").Value = Sheet1.Range("A11").Value
strBody = Join(WorksheetFunction.Transpose(.Range("A1:A7")), vbCrLf)
End With
MsgBox strBody


strBody = RangetoHTML(Sheet2.Range("A1:A7"))
MsgBox strBody

'Bold html tags added...
'Original, strBody from Sheet1 example
With Sheet1
strBody = "<b>" & .Cells(3, 1).Text & "</b>" & vbCrLf & vbCrLf & _
.Cells(5, 1).Text & vbCrLf & _
.Cells(7, 1).Text & vbCrLf & _
.Cells(9, 1).Text & vbCrLf & vbCrLf & _
.Cells(11, 1).Text
End With
MsgBox strBody
End Sub


'http://www.rondebruin.nl/win/s1/outlook/bmail2.htm
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