Excel Macro to email Data from the sheet using Outlook

powerwill · Aug 27, 2021

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

Logit · Aug 27, 2021

Why are you using TWO BODIES ?

VBA Code:

.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/>"

powerwill · Aug 27, 2021

Logit said:

Why are you using TWO BODIES ?

VBA Code:

.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/>"

Oops forgot to remove it, but the code works fine, except for the help I need. Can you help?

Logit · Aug 27, 2021

Post your workbook (no confidential data) to a download website (like : DropBox.com, etc.) then provide the link here.

powerwill · Aug 28, 2021

Logit said:
Post your workbook (no confidential data) to a download website (like : DropBox.com, etc.) then provide the link here.

Thank you @Logit Here you go: TEST_FILE

pass: mrexcel

I have removed several info and other macros that are working well. You'll only find two macros in the sheet one that creates an email and the other takes a screenshot.

FYI... In the sheet, data from the cells that are coded in blue are to be used in the email body.

My problems:

1) In the outlook email body, the table created using HTMLBODY fails to format the last three cells of the second column (time, percentage), eg- 5:30 PM, 100%. Also, the table border needs to be in a single line. Couldn't figure out how to use 'border-collapse'

2) The BLUE cells highlighted in the column 'H' will contain 'NA', '-', or any other written Remark. I need only the written remarks except "NA" & "-" to be numbered and listed in the email body after "Observations/Actions". In this case they are
1) This is a test Remark 1
2) This is a test Remark 2...etc
3)..

3) The macro "screenshot" captures the image of the form and pastes it in the 3rd sheet. The 3rd sheet may also contain several other manually pasted screen snippets of different size and ratio.. All these screen shots and snippets from the 3rd sheet needs to be pasted in the email body below the remarks once they have been numbered and listed.

Sorry for the long post @Logit just wanted to make myself clear. Appreciate any help.

Logit · Aug 28, 2021

Taking a 'screen shot' of the FORM to be inserted into an email in this case is
not recommended. The size of the FORM is such that the email itself will be
unmanageable when viewed. It would be best to attach a copy of the FORM to the
email for the recipient to view in their copy of EXCEL.

The following will attach THE CURRENT SHEET to an email which is also created by
the following code :

VBA Code:

Option Explicit

Sub Test_Mail_Sheet_Array()
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim TheActiveWindow As Window
    Dim TempWindow As Window

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook

    Set Destwb = ActiveWorkbook

    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2016
            Select Case Sourcewb.FileFormat
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            Case 52:
                If .HasVBProject Then
                    FileExtStr = ".xlsm": FileFormatNum = 52
                Else
                    FileExtStr = ".xlsx": FileFormatNum = 51
                End If
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
    End With

    TempFilePath = Environ$("temp") & "\"
    TempFileName = Sourcewb.Name & " " & ActiveSheet.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
   
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = Sheets("Front Sheet").Range("A6").Value 'I want this to refer to cell B6 on the tab called "Front Sheet" the actual email address(es) will be in that cell
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .Body = "Hi there"
            .Attachments.Add Destwb.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\test.txt")
            '.Send   'or use the following :
            .Display
        End With
        'On Error GoTo 0
        '.Close savechanges:=False
    End With

    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Quit
    End With
End Sub

The following code will select a specific range on a sheet, convert
it to a JPEG image, then paste that image into the body of an email.
If your "several other manually pasted screen snippets of different
size and ratio" are reasonably small, you could use this code.

Again I would not recommend pasting anything into the body of an
email that causes the viewing size to be unreasonable.

Code:

Option Explicit
'http://www.excelforum.com/excel-programming-vba-macros/1118528-viewing-my-range-as-a-jpg-and-send-via-email.html

Sub createJpg(Namesheet As String, nameRange As String, nameFile As String)
   
    Dim plage As Object
   
    ThisWorkbook.Activate
    Worksheets(Namesheet).Activate
   
    Set plage = ThisWorkbook.Worksheets(Namesheet).Range(nameRange)
    plage.CopyPicture
   
    With ThisWorkbook.Worksheets(Namesheet).ChartObjects.Add(plage.Left, plage.Top, plage.Width, plage.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
    End With
   
    Worksheets(Namesheet).ChartObjects(Worksheets(Namesheet).ChartObjects.Count).Delete
    Set plage = Nothing

End Sub

Sub sendMail()
       
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
   
    Dim TempFilePath As String 'location of temp image
    Dim imgRNG As String 'area for image
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As Variant
   
    imgRNG = "A1:I13" 'change this for range

    'Create a new Microsoft Outlook session
    Set OutApp = CreateObject("outlook.application")
           
    'create a new message
    Set OutMail = OutApp.CreateItem(0)
           
    With OutMail
   
        .Subject = "Insert Subject here"
       
        'following bit is to setup the image
        Call createJpg("Email", imgRNG, "MailAttach") 'Worksheet name
        TempFilePath = Environ$("temp") & "\"
        .Attachments.Add TempFilePath & "MailAttach.jpg", 0, 0
           
        'Then we add an html <img src=''> link to this image
        '<br> = line break
        '
        strbody = "<span LANG=EN>" & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
        & "Hello,<br><br>Insert message here, use for next line" & _
        "<br><B>Image:</B><br><br><img src='cid:MailAttach.jpg'<br>"
       
        .Display 'display email to grab signature
        .htmlbody = strbody & "<br>" & .htmlbody ' pass body of text then line break then insert signature
       
        .To = "contact1@email.com; contact2@email.com"
        .Cc = "contact3@email.com"
        '.Send 'if you want to autosend enable this
       
    End With
       
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub

The above code samples come from different projects ... so there is duplication
in the code. Take some time to condense the codes into a single viable project.

The other concerns you have listed in your post will hopefully be addressed by
another volunteer.

Best wishes.

powerwill · Aug 29, 2021

powerwill said:
Thank you @Logit Here you go: TEST_FILE

pass: mrexcel

I have removed several info and other macros that are working well. You'll only find two macros in the sheet one that creates an email and the other takes a screenshot.

FYI... In the sheet, data from the cells that are coded in blue are to be used in the email body.

My problems:

1) In the outlook email body, the table created using HTMLBODY fails to format the last three cells of the second column (time, percentage), eg- 5:30 PM, 100%. Also, the table border needs to be in a single line. Couldn't figure out how to use 'border-collapse'

2) The BLUE cells highlighted in the column 'H' will contain 'NA', '-', or any other written Remark. I need only the written remarks except "NA" & "-" to be numbered and listed in the email body after "Observations/Actions". In this case they are
1) This is a test Remark 1
2) This is a test Remark 2...etc
3)..

3) The macro "screenshot" captures the image of the form and pastes it in the 3rd sheet. The 3rd sheet may also contain several other manually pasted screen snippets of different size and ratio.. All these screen shots and snippets from the 3rd sheet needs to be pasted in the email body below the remarks once they have been numbered and listed.

Sorry for the long post @Logit just wanted to make myself clear. Appreciate any help.

Thank you @Logit for your help. I could do without the screenshot attachment, but the first two points I really need those to work. @Snakehips is there anything you could help?

Snakehips · Aug 29, 2021

@powerwill

Try this. I cannot test it beyond putting the html string for the body in Safari. See image.
But it looks pretty close to me. I have no idea how to edit the html to collapse the border.

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/>" & "<u><b>Session Details:<b/><u/>" & "<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

Hope that helps.

powerwill · Aug 30, 2021

Snakehips said:

@powerwill

Try this. I cannot test it beyond putting the html string for the body in Safari. See image.
But it looks pretty close to me. I have no idea how to edit the html to collapse the border.

View attachment 45880

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/>" & "<u><b>Session Details:<b/><u/>" & "<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

Hope that helps.

Amazing that worked! Thank you @Snakehips

Is there a way to not bold/underline the listed remarks? What part do I change in the html script?

Snakehips · Aug 30, 2021

powerwill said:
Amazing that worked! Thank you @Snakehips

Is there a way to not bold/underline the listed remarks? What part do I change in the html script?

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

Excel Macro to email Data from the sheet using Outlook

powerwill

Board Regular

Excel Facts

Logit

Well-known Member

powerwill

Board Regular

Logit

Well-known Member

powerwill

Board Regular

Logit

Well-known Member

powerwill

Board Regular

Snakehips

Well-known Member

powerwill

Board Regular

Snakehips

Well-known Member

Similar threads

Forum statistics

Share this page

Excel Macro to email Data from the sheet using Outlook

Board Regular

Excel Facts

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock