• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA for sending email with font format based on cell value

D

deenoseban

New Member
Hi ,

I tried to create an email set with below codes, but not able to get the format. The below is the sample data and code

Code: 
Sub Report_email()

ActiveWorkbook.Save

Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)


On Error Resume Next
With OutlookMail
    .To = "xoosi@galint.ae"
    .CC = "Dava@galint.ae"
    .BCC = ""
   .HTMLBody = "Dear Xoosi," & "<br><br>" & _
    "Please find the below analysis " & "<br><br>" & _
    "Revenue for the current month is " & Range("B2") & "  Previous month is " & Range("C2") & "  Variance is "

    .Display
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub

the below is the result that I am looking for. But the % in red color (as figure is -ve)formatting is not working with my codes.



Revenue for the current month is 120 Previous month is 126 Variance is 4.8%

the below is the data set where email is drafted attached the sample file.

1582051322225-png.65661
 

Attachments

  • 1582051322225.png
    1582051322225.png
    6.6 KB · Views: 98
  • Send email with figures.xlsm
    73.8 KB · Views: 7
Last edited by a moderator:
Your VBA project is password protected.
Try:
Code: 
Sub Report_email()

ActiveWorkbook.Save

Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)


On Error Resume Next
With OutlookMail
  .To = "xoosi@galint.ae"
  .CC = "Dava@galint.ae"
  .BCC = ""
  HTMLB = "Dear Xoosi," & "<br><br>" & _
          "Please find the below analysis " & "<br><br>" & _
          "Revenue for the current month is " & Range("B2") & "  Previous month is " & Range("C2") & "  Variance is "
  If Range("D2") < 0 Then
    HTMLB = HTMLB & "<font color=""red"">" & Range("D2").Text & "</font>"
    'HTMLB = HTMLB & "<span style=""color:#FF0000;"">" & Range("D2").Text & "</span>" 'seems to work too.
  Else
    HTMLB = HTMLB & Range("D2").Text
  End If
  .HTMLBody = HTMLB
  .Display
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub
 
Last edited:
p45cal said:
Your VBA project is password protected.
Try:
Code: 
Sub Report_email()

ActiveWorkbook.Save

Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)


On Error Resume Next
With OutlookMail
  .To = "xoosi@galint.ae"
  .CC = "Dava@galint.ae"
  .BCC = ""
  HTMLB = "Dear Xoosi," & "<br><br>" & _
          "Please find the below analysis " & "<br><br>" & _
          "Revenue for the current month is " & Range("B2") & "  Previous month is " & Range("C2") & "  Variance is "
  If Range("D2") < 0 Then
    HTMLB = HTMLB & "<font color=""red"">" & Range("D2").Text & "</font>"
    'HTMLB = HTMLB & "<span style=""color:#FF0000;"">" & Range("D2").Text & "</span>" 'seems to work too.
  Else
    HTMLB = HTMLB & Range("D2").Text
  End If
  .HTMLBody = HTMLB
  .Display
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub
Click to expand...


Awesome...... Thank you so much. This will make my life easy.
 
Code: 
HTMLB = "<BODY style=""font-size:11pt;font-family:Calibri"">Dear Xoosi," & "<br><br>" & _
          "Please find the below analysis " & "<br><br>" & _
          "Revenue for the current month is " & Range("B2") & "  Previous month is " & Range("C2") & "  Variance is "
 
p45cal said:
Code: 
HTMLB = "<BODY style=""font-size:11pt;font-family:Calibri"">Dear Xoosi," & "<br><br>" & _
          "Please find the below analysis " & "<br><br>" & _
          "Revenue for the current month is " & Range("B2") & "  Previous month is " & Range("C2") & "  Variance is "
Click to expand...

Thank you. This worked very well.
 
Hi ... I need a help, the file which macro was made needs an update. One more column was added to compare prev.month and I am not able to figure it out. Could someone please look into it. Below is my current codes

"
Code: 
Sub Report_email()

ActiveWorkbook.Save

Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)


On Error Resume Next
With OutlookMail
.To = "xoosi@galint.ae"
.CC = "Dava@galint.ae"
.BCC = ""

HTMLB = "<BODY style=""font-size:11pt;font-family:Calibri"">Dear Xoosi," & "<br><br>" & _
"Please find the below analysis " & "<br><br>" & _
"Revenue for the current month is " & Range("B2") & "  Previous month is " & Range("C2") & "  Variance vs. Budget is "
If Range("D2") < 0 Then
HTMLB = HTMLB & "<font color=""red"">" & Format(Range("D2"), "0.0%") & "</font>"
Else
HTMLB = HTMLB & Format(Range("D2"), "0.0%")
End If

&_ "Variance vs. prev month is"

If Range("E2") < 0 Then
HTMLB = HTMLB & "<font color=""red"">" & Format(Range("e2"), "0.0%") & "</font>"
Else
HTMLB = HTMLB & Format(Range("E2"), "0.0%")
End If


HTMLB1 = "<BODY style=""font-size:11pt;font-family:Calibri"">COGS for the current month is " & Range("B3") & "  Previous month is " & Range("C3") & "  Variance is "
If Range("D3") < 0 Then
HTMLB1 = HTMLB1 & "<font color=""red"">" & Format(Range("D3"), "0.0%") & "</font>"
Else
HTMLB1 = HTMLB1 & Format(Range("D3"), "0.0%")
End If


HTMLB2 = "<BODY style=""font-size:11pt;font-family:Calibri"">Proft for the current month is " & Range("B4") & "  Previous month is " & Range("C4") & "  Variance is "
If Range("D4") < 0 Then
HTMLB2 = HTMLB2 & "<font color=""red"">" & Format(Range("D4"), "0.0%") & "</font>"
Else
HTMLB2 = HTMLB2 & Format(Range("D4"), "0.0%")
End If



.HTMLBody = HTMLB + HTMLB1 + HTMLB2
.Display

End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub
"

below is the mail which should look , please help
65768
 

Attachments

  • Send email with figures formatting.xlsm
    68.7 KB · Views: 10
Last edited by a moderator:
Code: 
Sub Report_email()
Dim OutlookApp As Object, OutlookMail As Object

Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
ActiveWorkbook.Save
'On Error Resume Next

DescArray = Array("Revenue", "COGS", "Profit")
With OutlookMail
  .To = "xoosi@galint.ae"
  .CC = "Dava@galint.ae"
  .BCC = ""
 
  HTMLB = "<BODY style=""font-size:11pt;font-family:Calibri"">Dear Xoosi," & "<br><br>" & "Please find the below analysis <br>"
  For rw = 2 To 4
    d = rw - 2 + LBound(DescArray)
    HTMLB = HTMLB & "<br>" & DescArray(d) & " for the current month is " & Range("B" & rw) & "  Previous month is " & Range("C" & rw) & "  Variance vs. Budget is "
    If Range("D" & rw) < 0 Then
      HTMLB = HTMLB & "<font color=""red"">" & Format(Range("D2"), "0.0%") & "</font>"
    Else
      HTMLB = HTMLB & Format(Range("D" & rw), "0.0%")
    End If
    HTMLB = HTMLB & " Variance vs. prev month is "
    If Range("E" & rw) < 0 Then
      HTMLB = HTMLB & "<font color=""red"">" & Format(Range("E" & rw), "0.00%") & "</font>"
    Else
      HTMLB = HTMLB & Format(Range("E" & rw), "0.00%")
    End If
  Next rw
  .HTMLBody = HTMLB
  .Display
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub
 
p45cal said:
Code: 
Sub Report_email()
Dim OutlookApp As Object, OutlookMail As Object

Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
ActiveWorkbook.Save
'On Error Resume Next

DescArray = Array("Revenue", "COGS", "Profit")
With OutlookMail
  .To = "xoosi@galint.ae"
  .CC = "Dava@galint.ae"
  .BCC = ""

  HTMLB = "<BODY style=""font-size:11pt;font-family:Calibri"">Dear Xoosi," & "<br><br>" & "Please find the below analysis <br>"
  For rw = 2 To 4
    d = rw - 2 + LBound(DescArray)
    HTMLB = HTMLB & "<br>" & DescArray(d) & " for the current month is " & Range("B" & rw) & "  Previous month is " & Range("C" & rw) & "  Variance vs. Budget is "
    If Range("D" & rw) < 0 Then
      HTMLB = HTMLB & "<font color=""red"">" & Format(Range("D2"), "0.0%") & "</font>"
    Else
      HTMLB = HTMLB & Format(Range("D" & rw), "0.0%")
    End If
    HTMLB = HTMLB & " Variance vs. prev month is "
    If Range("E" & rw) < 0 Then
      HTMLB = HTMLB & "<font color=""red"">" & Format(Range("E" & rw), "0.00%") & "</font>"
    Else
      HTMLB = HTMLB & Format(Range("E" & rw), "0.00%")
    End If
  Next rw
  .HTMLBody = HTMLB
  .Display
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub
Click to expand...



Great work dude..... Thanks a lot
 
You must log in or register to reply here.
Back
Top