Excel Macro to email Data from the sheet using Outlook

[powerwill]

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.

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

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]

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.

'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?

 

[Snakehips]

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.

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.