Excel Macro to email Data from the sheet using Outlook

powerwill

New Member
Joined
Sep 14, 2018
Messages
31
Office Version
  1. 365
Platform
  1. Windows
I wrote this macro to send emails with a click of a button.

But I have a couple of things that I need help on.

1) The code contains a Table that is created with .HTMLbody, everything is fine, except for the second cell of the last row. The Range("F14").Value gets the Time in a Text Format, which makes 5:30 PM look like 0.729166666666667 when the email is displayed.

2) There are certain Cell Ranges on the sheet (H19:H48), (B51:B55) & (H51:H55), which can either contain a Regular TEXT (remarks that are written manually), or “NA” or “ - ”. I need a macro that would exclude “NA” & “-“ and pull only the Regular Text (remarks) and list them vertically in a numerical order in the email body eg: 1)…2)… vertically**

3) Lastly I need the second code integrated into this First Macro, so it could paste the image of the sheet in the email body as well after the remarks are listed.

VBA Code:
Sub DisplayEmail()

 

Dim emailApplication As Object

Dim emailItem As Object

 

Set emailApplication = CreateObject("Outlook.Application")

Set emailItem = emailApplication.CreateItem(0)

 

With emailItem

 

    .To = Range("F5").Value

  

    .CC = Range("K2").Value

 

    .Subject = "Quality Audit and Feedback | Audit ID: " & Range("F3").Value

 

    .Body = "Hi " & Range("Q4").Value & "," & vbNewLine & vbNewLine & "Below is the snapshot of your audit." & vbNewLine & vbNewLine & "Please reach out for any clarification."

 

    .HTMLBody = "Hi " & Range("Q4").Value & "," & "<br/><br/>" & "Below is the snapshot of your audit." & "<br/><br/>" & "Please reach out for any clarification." & "<br/><br/>" & "<u><b>Session Details:<b/><u/>" & "<br/><br/>" & "<table border=1><tbody><tr><th>Course Run Code:</th><td>" & Range("F11").Value & "</td></tr>" & "<tr><th>Session Title:</th><td>" & Range("F12").Value & "</td></tr>" & "<tr><th>Session Date:</th><td>" & Range("F13").Value & "</td></tr>" & "<tr><th>Session Time (IST):</th><td>" & Range("F14").Value & "</td></tr></tbody></table>" & "<br/>" & "<u><b>Observation/Actions:<b/><u/>"

  

    .Display

 

Set emailItem = Nothing

Set emailApplication = Nothing

 

End With

End Sub

VBA Code:
Sub ScreenShot()

'

' ScreenShot Macro

'

 

'

    Cells.Select

    Range("D9").Activate

    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    Sheets("Image Captured Here").Select

    Range("A1").Select

    ActiveSheet.Paste

    Sheets("Quality Form").Select

    Range("D9").Select

    Selection.Copy

    Application.CutCopyMode = False

End Sub
 

powerwill

New Member
Joined
Sep 14, 2018
Messages
31
Office Version
  1. 365
Platform
  1. Windows
You are welcome. If I hadn't been working on your issue, I'd have only been enjoying my Sunday by watching footy or cricket or something. ;)

I know diddly-squat about html but, try substituting this revised bit of the code.

VBA Code:
'body html
BodStrng = "Hi " & EName & "," & "<br/><br/>" & "Below is the snapshot of your audit." & "<br/><br/>" _
& "Please reach out for any clarification." & "<br/><br/>" & "Session Details:" & "<br/><br/>" _
& "<table border=1><tbody><tr><th>Test Code:</th><td>" & ECode & "</td></tr>" & "<tr><th>Test Title:</th><td>" & ETitle _
& "</td></tr>" & "<tr><th>Test Date:</th><td>" & EDate & "</td></tr>" & "<tr><th>Test Time(PST):</th><td>" & ETime _
& "</td></tr>" & "<tr><th>Test Scores %:</th><td>" & EScores & "</td></tr>" & "<tr><th>Test Accuracy %:</th><td>" & EAccy _
& "</td></tr></tbody></table>" & "<br/>" & "Observation/Actions: "
Hahaha sorry to ruin your Sunday, my Monday has begun already, forgot you're in a different timezone.

The replaced code removes Bold/underline from the entire email body. How about just keeping the 'numbered remarks' in plain text. Is that even possible?
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

Snakehips

Well-known Member
Joined
May 17, 2009
Messages
5,394
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
As I said, I know nothing of html. I just used your original code as the basis for the additions that I did.
I now notice that you were using <br/> Probably not an issue but it would appear that <br> will suffice.
Also, you had <b/><u/> to end to bold and underline. I now believe that should be </b> </u>
Hence why, previously, I could only suppress the bold and underline by removing <b><u> altogether.

So with my newfound knowledge (?), try this.

VBA Code:
Sub SendEmail()

Dim emailApplication As Object
Dim emailItem As Object
Dim RemCell As Range
Dim RemStrng As String, BodStrng As String
Dim EName As String, ECode As String, ETitle As String
Dim EDate As String, ETime As String, EScores As String, EAccy As String
Dim c As Integer

'body sub-strings
EName = Range("Q4")   '<<<<????
ECode = Range("F11")
ETitle = Range("F12")
EDate = Format(Range("F13").Value, "dd-mmm-yy")
ETime = Format(Range("F14"), "h:mm am/pm")
EScores = Format(Range("H15"), "000%")
EAccy = Format(Range("D16"), "000%")
' loop to build valid remarks html string
For Each RemCell In Range("H19:H55")

    Select Case Trim(RemCell.Value)
        Case "-", "NA", "REMARKS", ""
        'Do Nothing
        Case Else
       'add to string
        c = c + 1
        RemStrng = RemStrng & c & ")  " & RemCell & "<br><br>"
    End Select

Next RemCell
'body html
BodStrng = "Hi " & EName & "," & "<br><br>" & "Below is the snapshot of your audit." & "<br><br>" _
& "Please reach out for any clarification." & "<br><br>" & "Session Details:" & "<br><br>" _
& "<table border=1><tbody><tr><th>Test Code:</th><td>" & ECode & "</td></tr>" & "<tr><th>Test Title:</th><td>" & ETitle _
& "</td></tr>" & "<tr><th>Test Date:</th><td>" & EDate & "</td></tr>" & "<tr><th>Test Time(PST):</th><td>" & ETime _
& "</td></tr>" & "<tr><th>Test Scores %:</th><td>" & EScores & "</td></tr>" & "<tr><th>Test Accuracy %:</th><td>" & EAccy _
& "</td></tr></tbody></table>" & "<br>" & "<u><b>" & "Observation/Actions:" & "</b></u>"

BodStrng = BodStrng & "<br/>" & RemStrng

Set emailApplication = CreateObject("Outlook.Application")
Set emailItem = emailApplication.CreateItem(0)

With emailItem

    .to = Range("F5").Value
    .CC = Range("K2").Value
    .Subject = "Quality Audit & Feedback | Audit ID: " & Range("F3").Value
    .HTMLBody = BodStrng
    .Display

Set emailItem = Nothing
Set emailApplication = Nothing

End With
End Sub

If that isn't quite as you would like then just add or edit the body string using <b><u> and </b></u> ,to suit.
 
Solution
Learn Excel from Bill Jelen

Understanding data is crucial, and the easiest place to start is with Microsoft Excel.

Forum statistics

Threads
1,151,589
Messages
5,765,312
Members
425,272
Latest member
Umba

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
Top