Formatting the body of an Outlook email?

J

jmpatrick

Active Member
Joined
Aug 17, 2016
Messages
477
Office Version
  1. 365
Platform
  1. Windows
Good morning. I have this code that creates an Outlook email message based on data from my Sheet and sends to the person I select. Now I'm wondering if it's possible to format the body of the message...

VBA Code: 
Sub SendPlanRequestUpdateEmail()

    Call FloorPlanRequests
    
    Dim Ans As VbMsgBoxResult
    Ans = MsgBox("Are you sure you want to Send a Floor Plan Request Update?", vbYesNo + vbQuestion)
    If Ans = vbNo Then Exit Sub
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    Sheets("FloorPlanRequests").Visible = True
    Sheets("FloorPlanRequests").Select
    ActiveSheet.Unprotect

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    Set rng = Sheets("FloorPlanRequests").Range("FloorPlanRequests").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

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

    On Error Resume Next
    With OutMail
        .To = Settings.DesignerEmailReturn.Value
        .CC = Settings.CCNames.Value
        .Subject = "Floor Plan Request Update for " & Format(Now, "m/dd/yy")
        .HTMLBody = "In order of priority:" & "<br>" & RangetoHTML(rng) & "<br>" & "Thanks!"
        .Send
    End With
    On Error GoTo 0
    
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("FloorPlanRequests").Visible = False
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
    
    Sheets("Calendar").Select
   
End Sub
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
Sort by date Sort by votes
Not sure what you mean exactly by formatting, but here is an example where the body of the email is being made to be a certain font, red color, 20pt font size, and made bold.

VBA Code: 
Sub OLF()
Dim oApp As Object:     Set oApp = CreateObject("Outlook.Application")
Dim oM As Object:       Set oM = oApp.createitem(0)

With oM
    .to = "You"
    .Subject = "Test"
    .htmlbody = "<b><p style=""font-family:courier;color:red;font-size:20pt;"">This is a paragraph.</p></b>"
    .display
End With

Set oM = Nothing
Set oApp = Nothing
End Sub
 
Upvote 0
lrobbo314 said:
Not sure what you mean exactly by formatting, but here is an example where the body of the email is being made to be a certain font, red color, 20pt font size, and made bold.

VBA Code: 
Sub OLF()
Dim oApp As Object:     Set oApp = CreateObject("Outlook.Application")
Dim oM As Object:       Set oM = oApp.createitem(0)

With oM
    .to = "You"
    .Subject = "Test"
    .htmlbody = "<b><p style=""font-family:courier;color:red;font-size:20pt;"">This is a paragraph.</p></b>"
    .display
End With

Set oM = Nothing
Set oApp = Nothing
End Sub
Click to expand...

That works fine but I can't figure out how to apply the formatting to the data that comes over from RangetoHTML(rng).
 
Upvote 0
lrobbo314 said:
Not sure what you mean exactly by formatting, but here is an example where the body of the email is being made to be a certain font, red color, 20pt font size, and made bold.

VBA Code: 
Sub OLF()
Dim oApp As Object:     Set oApp = CreateObject("Outlook.Application")
Dim oM As Object:       Set oM = oApp.createitem(0)

With oM
    .to = "You"
    .Subject = "Test"
    .htmlbody = "<b><p style=""font-family:courier;color:red;font-size:20pt;"">This is a paragraph.</p></b>"
    .display
End With

Set oM = Nothing
Set oApp = Nothing
End Sub
Click to expand...

Using your suggestion I was able to include the data I needed:

VBA Code: 
.htmlbody = "<b><p style=""font-family:courier;color:red;font-size:20pt;"">In order of priority:</p></b>" & "<br>" & RangetoHTML(rng) & "<br>" & "<b><p style=""font-family:courier;color:red;font-size:20pt;"">Thanks!</p></b>"

Thanks!
 
Upvote 0
Looping back to this (and answering my own original question in case someone else is trying to format the body of their vba-generated email messages). This is what finally worked for me:

VBA Code: 
Sub SendPlanRequestUpdateEmail()
    
    Dim Ans As VbMsgBoxResult
    Ans = MsgBox("Are you sure you want to Send a Floor Plan Request Update?", vbYesNo + vbQuestion)
    If Ans = vbNo Then Exit Sub
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    Sheets("FloorPlanRequests").Visible = True
    Sheets("FloorPlanRequests").Select
    ActiveSheet.Unprotect

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    Set rng = Sheets("FloorPlanRequests").Range("FloorPlanRequests").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

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

    On Error Resume Next
    With OutMail
        .To = Settings.DesignerEmailReturn.Value
        .CC = Settings.CCEmailReturn.Value
        .BCC = Settings.BCCEmailReturn.Value
        .Subject = "Floor Plan Request Update for " & Format(Now, "m/dd/yy")
        .htmlbody = "<spanfont-size:14pt;"">In order of priority:" & RangetoHTML(rng) & "<br>" & Settings.FloorPlanRequestMessage.Value
        .Send
    End With
    On Error GoTo 0
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
      
End Sub

RangetoHTML(rng) is a nice piece of code sourced from Ron de Bruin's excellent Excel Automation website. The code allows you to use a range to form the body of an email message.

www.rondebruin.nl

Home | Ron de Bruin Excel Automation

Welcome to https://www.rondebruin.nl
www.rondebruin.nl www.rondebruin.nl
 
Upvote 0
Good morning, Mr. Excel-lovers!

I need to revisit this one. I'm having three issues as shown in the screen shot below.

- I need to get rid of the blank line that shows up above the RangetoHTML(Rng) text.
- I need a blank line/carriage return between Flex 2 Room and This home is the model. You'll see & vbCrLf in my code below. Doesn't work.
- The text that comes from the Settings.FloorPlanRequestMessageRequest.Value should be 14pt. like the rest of the message body.


outlook.png


VBA Code: 
Sub SendPlanRequestEmail()

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Sheets("Calendar").Select
    
    Call RememberWindowPosition
    
    Range("P" & (ActiveCell.Row)).Select
    Range(ActiveCell.Address).Name = "StartCell"
    
    Call FloorRequest
    Call SendFloorRequestRange
    
    Dim r As Range, x, c, d, Y, a
    x = Settings.DesignerNamesRequest.Value
    c = Settings.CCNamesRequest.Value
    d = Settings.BCCNamesRequest.Value
    Y = Worksheets("SendFloorRequest").Range("L1").Value
    
    'Dim Ans As VbMsgBoxResult
    
    'Ans = MsgBox("Are you sure you want to send a Floor Plan Request for " & Y & " to the following? " & vbCrLf & _
    'vbCrLf & _
    'x & vbCrLf & _
    'c & vbCrLf & _
    'd, vbYesNo + vbQuestion)
    
    'If Ans = vbNo Then Exit Sub
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Dim Rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set Rng = Nothing
    On Error Resume Next
    Set Rng = Selection.SpecialCells(xlCellTypeVisible)
    Set Rng = Sheets("SendFloorRequest").Range("FloorPlanRequestRange").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If Rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

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

    On Error Resume Next
    With OutMail
        .To = Settings.DesignerEmailReturnRequest.Value
        .CC = Settings.CCEmailReturnRequest.Value
        .BCC = Settings.BCCEmailReturnRequest.Value
        .Subject = Worksheets("SendFloorRequest").Range("K1").Value
        .htmlbody = RangetoHTML(Rng) & vbCrLf & Settings.FloorPlanRequestMessageRequest.Value
        .Attachments.Add Worksheets("SendFloorRequest").Range("I1").Value
        .Attachments.Add Worksheets("SendFloorRequest").Range("I2").Value
        .display
        '.Send
    End With
    On Error GoTo 0
    
    'ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("FloorPlanRequests").Visible = False

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
    
    Sheets("Calendar").Select
    
    Application.GoTo "StartCell"
    
    ActiveCell.FormulaR1C1 = "'" & Format(Now, "m/d")
    
    Range("P" & (ActiveCell.Row)).Select
    Range(ActiveCell.Address).Name = "StartCell"
  
    Dim vCellValue As Variant
    Dim sText As String
  
    vCellValue = ActiveCell.Value
    If IsNumeric(vCellValue) Then
        vCellValue = CDbl(vCellValue)
    End If
    
    x = Settings.DesignerNamesRequest.Value
      
    sText = Application.UserName & ":" & vbCrLf
    sText = sText & "Sent to " & x & vbCrLf
    sText = sText & Format(Now, "M/DD/YY H:MM AM/PM")
  
    With ActiveCell
        .ClearComments
        With .AddComment
            .Text sText
            With .Shape
                .TextFrame.Characters(1, InStr(sText, ":")).Font.Bold = True
                .Width = 180
                .Height = 60
                With .TextFrame.Characters.Font
                   .Name = "Tahoma"
                   .Size = 12
                End With
                With .TextFrame
                   .AutoSize = True
                End With
            End With
        End With
    End With
    
    Range("DA" & (ActiveCell.Row)).Value = Settings.DesignerNamesRequest.Value
    Range("DB" & (ActiveCell.Row)).Value = [Text(Now(), "MM/DD/YYYY HH:MM:SS AM/PM")]
    Range("DD" & (ActiveCell.Row)).Value = [Text(Now(), "M/D")]

    
    Call RestoreWindowPosition
    
    Call FloorPlanRequestsClear
    Call RunPlanRequests
    Call FloorPlanRequestsFormulasRange
    Call FloorPlanRequestsFormulasPaste
    Call FloorPlanRequestsRange
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
   
End Sub
 

Attachments

  • outlook.png
    outlook.png
    18 KB · Views: 3
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question
Combining two codes by Using a Messagebox like Form with yes/no or alike
Replies
1
Views
99
lojanica
L
G
  • Question
Email from Excel query
Replies
0
Views
157
gmazza76
G
S
  • Question
VBA Code hangs on Outlook Send?
Replies
2
Views
350
shophoney
S
M
  • Question
Creating and emailing Excel sheet with only visible data
Replies
0
Views
151
mecerrato
M
C
  • Question
VBA - Email specific range and attach Sheet1
Replies
4
Views
484
Clermont
C

Forum statistics

Threads
1,214,599
Messages
6,120,453
Members
448,967
Latest member
grijken

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top