a little play with the code
"<BR>Today's " & Date & " position is: " & cell.Offset(0, 5).Value & "<h3><font color =red > over the limit " & cell.Offset(0, 6).Value & ...................
Sub TestFile()
Dim OutApp As Object
Dim OutMail As Object
Dim rng As Range
Dim cell As Range
Dim R1 As Range
Dim R2 As Range
' Dim eCell As Range
Dim strbody As String
For Each cell In Range("G1:H2")
strbody = strbody & cell.Value & vbNewLine
Next
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
Set R1 = Range("F1:H1")
Set R2 = cell.Offset(0, 4).Resize(1, 3)
Set rng = Union(R1, R2)
If cell.Value Like "?*@?*.?*" And _
(Cells(cell.Row, "E").Value) = "Active" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.CC = cell.Offset(0, 1)
.BCC = cell.Offset(0, 2)
.Subject = "Prepaid Account Balance"
.HTMLBody = "<H4>Dear " & cell.Offset(0, -1).Value & "</H4>" & _
"Hope you are fine<BR>" & _
"<BR>Please find below the current status<BR>" & _
"of your account" & _
"<H4><U>Balance Summary</U></H4>" & _
RangetoHTML(rng) & _
"<BR>Today's " & Date & " position is: " & cell.Offset(0, 5).Value & "<h3><font color =red > over the limit " & cell.Offset(0, 6).Value & "</H4></font></h3>Request you to make immediate payment.For queries please revert or call, I will be glad to assist. <BR>" & _
"<BR>Best Regards<BR>" & _
"<H4>Nutty</H4>" & _
"<H4>India</H4></BR>"
'.Send 'Or use
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Bookmarks