I am trying to change the text so certain values from cells are either bold, underlined, red, or otherwise stand out from the surrounding text in the body of the email.
How can I do that?
For i = 10 To 18
If Not Cells(i, "A").Text = vbNullString Then
'Add to growing string
concatString = concatString + Cells(i, "A").Text & ", " & _
Cells(i, "B").Text & vbCr
concatString = concatString + "Assignment/Zone: " & _
Cells(i, "C").Text & vbNewLine & vbCr
End If
Next i
myMail.Body = Range("B2") & " Shift" & " - " & Format(Date, "mmmm dd, yyyy") _
& vbNewLine & vbNewLine & "Sergeant: " & Range("A6") & ", " & Range("B6") & _
vbNewLine & " Status: " & Range("C6") _
& vbNewLine & vbNewLine & "Corporal: " & Range("A8") & ", " & Range("B8") & _
vbNewLine & " Status: " & Range("C8") _
& vbNewLine & vbNewLine & "Assigned Deputies" & vbNewLine & vbNewLine & concatString
You need to look into using HTML-formatted content to apply the colors etc you want:
Dim oApp As Object, oMail As Object
Set oApp = CreateObject("outlook.application")
Set oMail = oApp.createitem(0)
oMail.Display
oMail.htmlBody = "<h1>This is a heading</h1>" & _
"<p style='color:#F00'>Some red text</p>" & _
"<p><u>Underlined</u></p>" & _
"<p><b>Bold</b></p>" & _
"<p><i>Italic</i></p>"
I needed to use <br> to put the resultant answer in the email body. <p> creates a new PARAGRAPH, while <br> just puts it on the next line.
& "<br><b><u>Status:</u></b>"
gives:
& "Status:" &
Instead of:
& "<p><b><u>Status:</u></b>"
Which gives:
& "Status:"
Thank you for your help!
Related
My current working Macro is:
Sub emailGenerator()
'Disable Screen Updating
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
ThisWorkbook.Sheets("Email").Activate
Worksheets("Email").Visible = False
'ThisWorkbook.Sheets("P6").Activate
ActiveWorkbook.Save
Worksheets("Email").Visible = True
ThisWorkbook.Sheets("Email").Activate
Dim TempFilePath As String
Dim nameOfProject As String
Dim firstName As String
nameOfProject = Cells(3, 7)
firstName = Cells(4, 7)
'Create a new Microsoft Outlook session
Set appOutlook = CreateObject("outlook.application")
'create a new message
Set Message = appOutlook.CreateItem(olMailItem)
With Message
.Subject = nameOfProject & " Programme Analytical Tool"
.HTMLBody = "<span LANG=EN>" _
& "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
& "Hi " & firstName & ",<br ><br >Please find attached the analytical tool for " & nameOfProject & ". Commentary below:" _
& "<br><br>" & " - " & Cells(7, 2) _
& "<br>" & " - " & Cells(9, 2) _
& "<br>" & " - " & Cells(11, 2) _
& "<br>" & " - " & Cells(13, 2) _
& "<br>" & " - " & Cells(15, 2) _
& "<br>" & " - " & Cells(17, 2) _
& "<br>" & " - " & Cells(19, 2) _
& "<br>" & " - " & Cells(21, 2) _
& "<br>" & " - " & Cells(23, 2) _
& "<br>" & " - " & Cells(25, 2) _
& "<br>" & " - " & Cells(27, 2) _
& "<br>" & " - " & Cells(29, 2) _
& "<br>" & " - " & Cells(31, 2) _
& "<br><br><BR>"
'first we create the image as a JPG file
'Call createJpg("GRAPHS", "B2:AA90", "OFGraph")
'we attached the embedded image with a Position at 0 (makes the attachment hidden)
TempFilePath = Environ$("temp") & "\"
'.attachments.Add TempFilePath & "OFGraph.jpg", olByValue, 0
.attachments.Add ActiveWorkbook.FullName
'.attachments.Add "\\MSQFDC02\DFSRoot$\NW\NW08Groups\LNW North ASM Team\Incident Management Specialist\OUTSTANDING FAULT SUMMARIES\UNVERIFIED & OUTSTANDING FAULT SUMMARYs\DELIVERY UNITs\Closing of Faults Form.docx"
'Then we add an html <img src=''> link to this image
'Note than you can customize width and height - not mandatory
'.HTMLBody = .HTMLBody _
'& "<img src='cid:OFGraph.jpg'" & "width='1100' height='1120'><br>"
' & "<img src='cid:OFGraph.jpg'" & "width='1400' height='1420'><br>"
.To = firstName
.CC = ""
.Display
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
I want to make those lines that are under the .HTMLBody more dynamic so I can add in more lines in the Excel sheet without having to re-visit the macro and tell it to read this specific line.
" & "" & " - " & Cells(x, 2) _"
Here's my attempt to make it dynamic and adding a loop, but not sure where it went wrong and it's highlighted as red.
This is how the sheet looks like:
I have the following listed in my Sheet 1 code, moving cell values to the body of an Outlook email.
I'm trying to STOP inserting text for the given line if the cell in Column A is empty.
Private Sub CommandButton1_Click()
'Create email with attachment, subject, and list of email addresses
ThisWorkbook.Save
Dim outlookApp As Object
Dim myMail As Object
Dim Source_File, to_emails, cc_emails As String
Dim file_to_send As String
Dim body_code As String
Dim i As Integer
Set outlookApp = CreateObject("Outlook.Application")
Set myMail = outlookApp.CreateItem(olMailItem)
For i = 2 To 22
to_emails = to_emails & Cells(i, 13) & ";"
'for CC: change the 13 to whatever column count from the left where your CC list is
'cc_emails = cc_emails & Cells(i, 13) & ";"
Next i
Source_File = ThisWorkbook.FullName
myMail.Attachments.Add Source_File
'myMail.CC = cc_emails
myMail.To = to_emails
myMail.Subject = Range("Q2").Value & " 10-8 Form " & Format(Date, "mm/dd/yy")
myMail.Body = Range("B2") & " Shift" & " - " & Format(Date, "mmmm dd, yyyy") _
& vbNewLine & vbNewLine & "Sergeant: " & Range("A6") & ", " & Range("B6") & vbNewLine & " Status: " & Range("C6") _
& vbNewLine & vbNewLine & "Corporal: " & Range("A8") & ", " & Range("B8") & vbNewLine & " Status: " & Range("C8") _
& vbNewLine & vbNewLine & "Assigned Deputies" & vbNewLine & vbNewLine & _
Range("A10") & ", " & Range("B10") & vbNewLine & " Assignment/Zone: " & Range("C10") & vbNewLine & _
Range("A11") & ", " & Range("B11") & vbNewLine & " Assignment/Zone: " & Range("C11") & vbNewLine & _
Range("A12") & ", " & Range("B12") & vbNewLine & " Assignment/Zone: " & Range("C12") & vbNewLine & _
Range("A13") & ", " & Range("B13") & vbNewLine & " Assignment/Zone: " & Range("C13") & vbNewLine & _
Range("A14") & ", " & Range("B14") & vbNewLine & " Assignment/Zone: " & Range("C14") & vbNewLine & _
Range("A15") & ", " & Range("B15") & vbNewLine & " Assignment/Zone: " & Range("C15") & vbNewLine & _
Range("A16") & ", " & Range("B16") & vbNewLine & " Assignment/Zone: " & Range("C16") & vbNewLine & _
Range("A17") & ", " & Range("B17") & vbNewLine & " Assignment/Zone: " & Range("C17") & vbNewLine & _
Range("A18") & ", " & Range("B18") & vbNewLine & " Assignment/Zone: " & Range("C18")
myMail.Display
ThisWorkbook.Save
End Sub
I would definitely break up that huge wall of text you have. This can be done with a loop.
Let's use a For loop here.
Dim concatString as String
For i = 10 To 18
If Not Cells(i, "A").Text = vbNullString Then
'Add to growing string
concatString = concatString + Cells(i, "A").Text & ", " & Cells(i, "B").Text & vbCr
concatString = concatString + "Assignment/Zone: " & Cells(i, "C").Text & vbCr
End If
Next i
If column A contains an empty string, we skip over it and move to the next row.
I posted this before you added more code, but I think you get the idea. Break up the huge chunk of code, and put only one cycle through columns A, B, and C in the loop. Adjust your loop constraints as necessary.
Here's what it would look like in your code:
'...
'your code here
'...
Dim concatString as String
For i = 10 To 18
If Not Cells(i, "A").Text = vbNullString Then
'Add to growing string
concatString = concatString + Cells(i, "A").Text & ", " & Cells(i, "B").Text & vbCr
concatString = concatString + "Assignment/Zone: " & Cells(i, "C").Text & vbCr
End If
Next i
myMail.Body = Range("B2") & " Shift" & " - " & Format(Date, "mmmm dd, yyyy") _
& vbNewLine & vbNewLine & "Sergeant: " & Range("A6") & ", " & Range("B6") & vbNewLine & " Status: " & Range("C6") _
& vbNewLine & vbNewLine & "Corporal: " & Range("A8") & ", " & Range("B8") & vbNewLine & " Status: " & Range("C8") _
& vbNewLine & vbNewLine & "Assigned Deputies" & vbNewLine & vbNewLine & concatString
I removed all those extra spaces, not sure if you actually need them in there or if it's a vestige of copying/pasting from VBE.
Here is the final code, the one that finally did it. Thank you to jclasley
`Private Sub CommandButton1_Click()
'Create email with attachment, subject, and list of email addresses
ThisWorkbook.Save
Dim outlookApp As Object
Dim myMail As Object
Dim Source_File, to_emails, cc_emails As String
Dim file_to_send As String
Dim i As Integer
Dim concatString As String
Set outlookApp = CreateObject("Outlook.Application")
Set myMail = outlookApp.CreateItem(olMailItem)
For i = 2 To 22
to_emails = to_emails & Cells(i, "M") & ";"
'for CC: change the 13 to whatever column count from the left where your CC list is
'cc_emails = cc_emails & Cells(i, 13) & ";"
Next i
Source_File = ThisWorkbook.FullName
myMail.Attachments.Add Source_File
'myMail.CC = cc_emails
myMail.To = to_emails
myMail.Subject = Range("Q2").Value & " 10-8 Form " & Format(Date, "mm/dd/yy")
For i = 10 To 18
If Not Cells(i, "A").Text = vbNullString Then
'Add to growing string
concatString = concatString + Cells(i, "A").Text & ", " & Cells(i, "B").Text & vbCr
concatString = concatString + "Assignment/Zone: " & Cells(i, "C").Text & vbNewLine & vbCr
End If
Next i
myMail.Body = Range("B2") & " Shift" & " - " & Format(Date, "mmmm dd, yyyy") _
& vbNewLine & vbNewLine & "Sergeant: " & Range("A6") & ", " & Range("B6") & vbNewLine & " Status: " & Range("C6") _
& vbNewLine & vbNewLine & "Corporal: " & Range("A8") & ", " & Range("B8") & vbNewLine & " Status: " & Range("C8") _
& vbNewLine & vbNewLine & "Assigned Deputies" & vbNewLine & vbNewLine & concatString
myMail.Display
ThisWorkbook.Save
End Sub
enter code here
I am trying to create a loop within VBA to have multiple selections from userform1's listbox2 when I hit the command button to draft an email with each selection in the following format. However, I can't figure out how to get more than just one selection into the body of the email. I tried to separate it into a "midbody" and add the code again, but it just adds the same entry twice. How can I make this loop work?
Private Sub CommandButton3_Click()
Dim objOutlook As Object
Dim objMail As Object
Dim midBody As String
Dim wksheet As String
Dim i As Integer
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i) = True Then
wksheet = ListBox2.List(i)
Sheets(wksheet).Activate
End If
If wksheet = "" Then
MsgBox "Nothing is Selected"
objMail.To = "myemail#me.com"
'objMail.CC =
objMail.Subject = ""
Else
midBody = activesheet.Range("C" & Rows.Count).End(xlUp).Value & vbNewLine & _
activesheet.Range("D" & Rows.Count).End(xlUp).Value & " through " & activesheet.Range("E" & Rows.Count).End(xlUp).Value & " phase" & vbNewLine & _
"Phase ECD: " & activesheet.Range("F" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Baseline Finish: " & activesheet.Range("G" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Previous Finish: " & activesheet.Range("H" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Current Finish: " & activesheet.Range("I" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Weekly Schedule Variance: " & activesheet.Range("J" & Rows.Count).End(xlUp).Value & vbNewLine & _
"CUM VAR to Baseline: " & activesheet.Range("K" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Slip Reason: " & vbNewLine & _
"Critical Path: " & vbNewLine & vbNewLine
objMail.body = midBody & Sheets.Range("C" & Rows.Count).End(xlUp).Value & vbNewLine & _
Sheets.Range("D" & Rows.Count).End(xlUp).Value & " through " & Sheets.Range("E" & Rows.Count).End(xlUp).Value & " phase" & vbNewLine & _
"Phase ECD: " & Sheets.Range("F" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Baseline Finish: " & Sheets.Range("G" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Previous Finish: " & Sheets.Range("H" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Current Finish: " & Sheets.Range("I" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Weekly Schedule Variance: " & Sheets.Range("J" & Rows.Count).End(xlUp).Value & vbNewLine & _
"CUM VAR to Baseline: " & Sheets.Range("K" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Slip Reason: " & vbNewLine & _
"Critical Path: " & vbNewLine & vbNewLine
End If
i = i + 1
Next i
objMail.Save
'Close the object
Set objMail = Nothing
MsgBox "Done", vbInformation
End Sub
I have made some changes in your code .Shifted Next of For towards later part of the code to include processing of loop. Removed redundant midBody.
Try This:
Private Sub CommandButton3_Click()
Dim ws As Worksheet
Dim i As Integer
Dim Agent As String
Dim EmailID As String
Dim wksheet As String
Dim objOutlook As Object
Dim objMail As Object
With Me.ListBox2
For i = 0 To .ListCount - 1
If .Selected(i) Then
wksheet = .List(i)
Exit For
End If
End With
If wksheet = "" Then
MsgBox "Nothing is Selected", vbExclamation
Exit Sub
End If
'r = Application.Match(wksheet, mySheet.Columns(1), 0)'choose one as per your data structure
r = Application.Match(Agent, mySheet.Columns(1), 0) 'choose one as per your data structure
Set ws = ThisWorkbook.ActiveSheet
'EmailID = mySheet.Range("D" & r).Value 'Uncomment it if this is required
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "myemail#me.com" ' Or EmailID
' .CC =
.subject = ""
.Body = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Value & vbNewLine & _
ActiveSheet.Range("D" & Rows.Count).End(xlUp).Value & " through " & ActiveSheet.Range("E" & Rows.Count).End(xlUp).Value & " phase" & vbNewLine & _
"Phase ECD: " & ActiveSheet.Range("F" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Baseline Finish: " & ActiveSheet.Range("G" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Previous Finish: " & ActiveSheet.Range("H" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Current Finish: " & ActiveSheet.Range("I" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Weekly Schedule Variance: " & ActiveSheet.Range("J" & Rows.Count).End(xlUp).Value & vbNewLine & _
"CUM VAR to Baseline: " & ActiveSheet.Range("K" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Slip Reason: " & vbNewLine & _
"Critical Path: " & vbNewLine & vbNewLine
'.Display
'.Send
.Save
End With
Next i
Set objMail = Nothing
Set objOutlook = Nothing
MsgBox "Done", vbInformation
End Sub
EDIT: Another version of code which works at my end. I have not created a listbox but simulated its working. This program loops correctly and send emails multiple times. Please remove k variable as per your listbox code . It is only for checking correct looping of the ptogram. Earlier version of program can be adjusted to your requirements if you provide sample data as what is the structure of listbox, from where it is picking emailid of the recipient, sample data of your worksheet etc.
Private Sub Command3_Click()
Dim subject As String, Body As String
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim ws As Worksheet
Dim k As Integer
On Error Resume Next
Set ws = ThisWorkbook.ActiveSheet
Set OutApp = GetObject(, "Outlook.Application")
If OutApp Is Nothing Then
Set OutApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
k = 4 ' remove it only for checking correct loop
For intCurrentRow = 0 To k - 1 'List2.ListCount change k to List2.ListCount
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
' List2.Selected(intCurrentRow) = True ' This is to be commented out after trials for looping
.To = "abc#gmail.com"
.subject = "Test 2nd time Email"
.Body = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Value & vbNewLine & _
ActiveSheet.Range("D" & Rows.Count).End(xlUp).Value & " through " & ActiveSheet.Range("E" & Rows.Count).End(xlUp).Value & " phase" & vbNewLine & _
"Phase ECD: " & ActiveSheet.Range("F" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Baseline Finish: " & ActiveSheet.Range("G" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Previous Finish: " & ActiveSheet.Range("H" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Current Finish: " & ActiveSheet.Range("I" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Weekly Schedule Variance: " & ActiveSheet.Range("J" & Rows.Count).End(xlUp).Value & vbNewLine & _
"CUM VAR to Baseline: " & ActiveSheet.Range("K" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Slip Reason: " & vbNewLine & _
"Critical Path: " & vbNewLine & vbNewLine
.Send
End With
Next intCurrentRow
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Outlook snapshot shows it is looping properly which was your main problem.
EDIT2: Earlier version of program simulated at my end on sample basis is running correctly and sending multiple mails. I do not have idea of your data setup so simulated for looping which was your main problem. Please try the program as it is , retain a copy and then make suitable adjustments for your data specific situation.
Private Sub CommandButton3_Click()
Dim ws As Worksheet
Dim i As Integer
Dim Agent As String
Dim EmailID As String
Dim wksheet As String
Dim objOutlook As Object
Dim objMail As Object
' With Me.ListBox2
For i = 1 To 3
'For i = 0 To .ListCount - 1
' If .Selected(i) Then
' wksheet = .List(i)
' Exit For
' End If
'End With
If wksheet = "hello" Then
MsgBox "Nothing is Selected", vbExclamation
Exit Sub
End If
'r = Application.Match(wksheet, mySheet.Columns(1), 0)'choose one as per your data structure
' r = Application.Match(Agent, mySheet.Columns(1), 0) 'choose one as per your data structure
Set ws = ThisWorkbook.ActiveSheet
'EmailID = mySheet.Range("D" & r).Value 'Uncomment it if this is required
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "abc#gmail.com" ' Or EmailID
' .CC =
.subject = "original test"
.Body = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Value & vbNewLine & _
ActiveSheet.Range("D" & Rows.Count).End(xlUp).Value & " through " & ActiveSheet.Range("E" & Rows.Count).End(xlUp).Value & " phase" & vbNewLine & _
"Phase ECD: " & ActiveSheet.Range("F" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Baseline Finish: " & ActiveSheet.Range("G" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Previous Finish: " & ActiveSheet.Range("H" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Current Finish: " & ActiveSheet.Range("I" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Weekly Schedule Variance: " & ActiveSheet.Range("J" & Rows.Count).End(xlUp).Value & vbNewLine & _
"CUM VAR to Baseline: " & ActiveSheet.Range("K" & Rows.Count).End(xlUp).Value & vbNewLine & _
"Slip Reason: " & vbNewLine & _
"Critical Path: " & vbNewLine & vbNewLine
'.Display
.Send
'.Save
End With
Next i
Set objMail = Nothing
Set objOutlook = Nothing
MsgBox "Done", vbInformation
End Sub
I made the codes below using this link as reference:
Dim chartPath As String
Dim messageA As String
Dim hyperlink As String
'Set chart path
chartPath = Environ("userprofile") & _
"\Documents\Chart " & Format(Now, "mm-dd-yyyy") & ".png"
'Set hyperlink
hyperlink = www.google.com
'Set message A
messageA = "<p style= 'font-family:arial;font-size:12'>" & "<b>" & Range("E17").Value & "</b>" & "<br>" & "<br>" & Range("E18").Value & "<br>" & "<br>" & Range("E19").Value & "<br>" & "<br>" & Range("E20").Value & " " & **"<b>" & "<u>" & "" & Range("E21").Value & "" & "</u>" & "</b>"** & " " & Range("E22").Value & "<br>" & "<br>" & "<b>" & "<u>" & Range("E23").Value & "</u>" & "</b>" & "<br>" & "<br>" & "</p>"
With OutlookMailItem
.HTMLBody = messageA & "<img src ='" & chartPath & "'>"
End With
However, the text which contains hyperlink does not direct me to the website once click and I think, using string for this part is the problem. What could be the possible remedy for this
I was not able to run your code but I found that these 2 lines should have some changes:
'Set hyperlink
hyperlink = "www.google.com" 'Added ""
'Also you can set the value from a cell.
hyperlink = Cells(1,1).Value 'Get value from cell A1.
'Set message A - Removed **
messageA = "<p style= 'font-family:arial;font-size:12'>" & "<b>" & Range("E17").Value & "</b>" & "<br>" & "<br>" & Range("E18").Value & "<br>" & "<br>" & Range("E19").Value & "<br>" & "<br>" & Range("E20").Value & " " & "<b>" & "<u>" & "" & Range("E21").Value & "" & "</u>" & "</b>" & " " & Range("E22").Value & "<br>" & "<br>" & "<b>" & "<u>" & Range("E23").Value & "</u>" & "</b>" & "<br>" & "<br>" & "</p>"
Please test your code again.
change this line hyperlink = www.google.com to this: hyperlink = "http://www.google.com"
If your URL has spaces in it, those need to be replaced with %20 - This code will convert it for you:
hyperlink = Replace(hyperlink, " ", "%20")
I am trying to add in an if statement half way through a HTML body of text I am using in VBA to send an e-mail.
I need to work out how to get the code to add extra hyperlinks if a cell in on one of the tabs has a value, there could be up to five that may need to be added.
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Display
.To = Accounts
.Subject = "Consolidated Account Statement " & myPolicynumber & " - " & mypolicyname
If myhyperlink2 = "" Then
.HTMLBody = "<HTML><BODY>" & "<FONT-size=""11.0pt"">" & "Hi Accounts" & "<br><br>" & _
" The Account Statement" & _
" for " & myPolicynumber & " (" & mypolicyname & ") is ready to be created. " & "<br><br>" & "<br><br>" & _
" The following Medical Extra Premium also need booking " & "<br><br>"
If Worksheets("FOR PA").Cells(13, 39).Value = "Medicals" Then
" Medical Extra Premium 1" & "<br><br>" & _
" Medical Extra Premium 2" & "<br><br>" & _
" Medical Extra Premium 3" & "<br><br>" & _
" Medical Extra Premium 4" & "<br><br>" & _
" Medical Extra Premium 5" & "<br><br>" & _
" Kind Regards," &.HTMLBody
.Send
Else
.HTMLBody = "<HTML><BODY>" & "<FONT-size=""11.0pt"">" & "Hi Accounts" & "<br><br>" & _
" The Initial" & " and the " & "Final & are ready to be put on the Account Statement " & _
" for " & myPolicynumber & " (" & mypolicyname & ") is ready to be created. " & "<br><br>" & _
" Kind Regards," & .HTMLBody
.Send
End If
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
You're doing the right thing, but you're missing a .HTMLBody = before one of the options:
If Worksheets("FOR PA").Cells(13, 39).Value = "Medicals" Then
.HTMLBody = " Medical Extra Premium 1" & "<br><br>" & _
" Medical Extra Premium 2" & "<br><br>" & _