Adding an If Statement into Html e-mail text in excel VBA - excel

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>" & _

Related

Loop through rows to populate Email body

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:

Adding line breaks in HTMLBody email code

When my email generates it doesn't have the line breaks despite using the "& vbCrLf &" code. I've tried using the <br> and <p> but I get compile errors every time.
Can someone please take a look at my code and help a brother out?
Dim strbody As String
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmailObj = xOutlookObj.CreateItem(0)
With xEmailObj
.Display
.to = xMemberName5
.CC = ""
.Subject = "Annual Review " + xMemberName + " " + "Cust " + xMemberName3
strbody = "<p style='font-family:calibri;font-size:11pt;color:rgb(31,78,121)'>" + xMemberName7 + "," _
& vbCrLf & vbCrLf & "Our records indicate that " + xMemberName + " is due for an annual pricing review. We are seeking an overall impact of " + xMemberName6 + "% increase to the rates. Updated Tariff page is attached." _
& vbCrLf & "If there are any pricing issues which need to be addressed, please get back to me no later than " & CDate(Date + 7) & "." _
& vbCrLf & vbCrLf & "Otherwise, the attached new pricing will be effective " + xMemberName4 + ". I encourage you to visit with your customer and deliver the new pricing ASAP." & .HTMLBody & "</body>"
.HTMLBody = strbody
Just include the <br>directly in your string as you did with <p> already
strbody = "<p style='font-family:calibri;font-size:11pt;color:rgb(31,78,121)'>" & xMemberName7 & "," _
& "<br><br>Our records indicate that " & xMemberName & " is due for an annual pricing review. We are seeking an overall impact of " & xMemberName6 & "% increase to the rates. Updated Tariff page is attached." _
& "<br>If there are any pricing issues which need to be addressed, please get back to me no later than " & CDate(Date + 7) & "." _
& "<br><br>Otherwise, the attached new pricing will be effective " & xMemberName4 & ". I encourage you to visit with your customer and deliver the new pricing ASAP." & .HTMLBody & "</body>"
And I recommend to use & instead of + to concatenate your variables with strings.

Extract CurrentRegion into email body

CurrentRegion is extracted but not shown in email body
Sub Draft()
Dim myDataRng As Range
Set myDataRng = Range("c2:c2")
Dim data As String
data = Range("B11").CurrentRegion.Select
For Each Cell In myDataRng
If Cell.Value > 0 Then
Dim objOutlook As Object
Set objOutlook = CreateObject("outlook.application")
Dim objEmail As Object
Set objEmail = objOutlook.CreateItem(olMailItem)
Range("K2").Select
With objEmail
.SentOnBehalfOfName = "accounting#test.co.uk"
.to = ActiveCell.Offset(0, 1).Value
.Subject = ActiveCell.Offset(7, 0).Value
.htmlbody = "Supplier Code " & " " & Cell.Offset(0, 0).Value & "<br>" & "Supplier Name: " & " " & Cell.Offset(1, 0).Value & "<br>" & "Currency " & " " & Cell.Offset(2, 0).Value & "<br>" & "<br>" & "Dear Supplier," & "<br>" & "<br>" & "A payment has been issued to you, as detailed below. " & "<br>" & data & "<br>" & "<br>" & "Kind Regards,<br>Johnny Grif <br>Accounts Assistant/Accounts Department" & "<br>" & "T:+44(0)1234 567 890" & "<br>" & "E:accounting#test.co.uk"
.Save
End With
Set objOutlook = Nothing
End If
Next Cell
Set myDataRng = Nothing
Set objEmail = Nothing: Set objOutlook = Nothing
MsgBox "Please check pyament advice in your draft folder!"
End Sub
The final outcome is like this.
Dear Supplier,
A payment has been issued to you, as detailed below.
True
Kind Regards,
Johnny Grif
Accounts Assistant/Accounts Department
T:+44(0)1234 567 890
E:accounting#test.co.uk
Below is the output:
The following code is the cause of the problem:
.htmlbody = "Supplier Code " & " " & Cell.Offset(0, 0).Value & "<br>" & "Supplier Name: " & " " & Cell.Offset(1, 0).Value & "<br>" & "Currency " & " " & Cell.Offset(2, 0).Value & "<br>" & "<br>" & "Dear Supplier," & "<br>" & "<br>" &
"A payment has been issued to you, as detailed below. " & "<br>" & data & "<br>" & "<br>" & "Kind Regards,<br>Johnny Grif <br>Accounts Assistant/Accounts Department" & "<br>" & "T:+44(0)1234 567 890" & "<br>" & "E:accounting#test.co.uk"
First of all, the message body markup should be represented by a well formed HTML document/string.
Second, if you need to break the line in the code you need to use the underscore _ character in the code to get the lines assembled correctly.
Third, I'd suggest breaking the code and trying to assemble the final from multiple pieces, so you could find out why the code doesn't work correctly.

Change the format in text pasted to Outlook

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!

Adding hyperlinks to Outlook Email body

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")

Resources