Adding excel cell value to mail body in vba

[Barbra090910]

I have the following lookup data that i need to display in an email.

My code (below) works, but does not display the actual words in the cells on the email.

What am i missing?


Dim xRg As Range
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Cells.Count > 1 Then Exit Sub
Set xRg = Intersect(Range("A2"), Target)
If xRg Is Nothing Then Exit Sub
If IsNumeric(Target.Value) And Target.Value > 0 Then
Call Mail_small_Text_Outlook
End If
End Sub
Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Good day," & vbNewLine & vbNewLine & _
"Upon completion of the Buckman COVID-19 checklist, B2 has indicated that he/she might be at risk of having COVID-19." & vbNewLine & _
"The following response was generated based on their Health assessment feedback:" & vbNewLine & _
"D2" & vbNewLine & _
"Please address this matter with the above-mentioned employee urgently!" & vbNewLine & _
"Kind Regards," & vbNewLine & _
"COVID-19 Monitoring Team"

On Error Resume Next
With xOutMail
.To = "bmetsebeth@buckman.com"
.Subject = "Employee Health Alert - C2 "
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

This is the email i get.

 

[maras]

Check something like this.
Best regards .

Sub Mail_small_Text_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Good day," & vbNewLine & vbNewLine & _
    "Upon completion of the Buckman COVID-19 checklist, " & [B2] & " has indicated that he/she might be at risk of having COVID-19." & vbNewLine & _
    "The following response was generated based on their Health assessment feedback:" & vbNewLine & _
            [D2] & vbNewLine & "" _
    & "Please address this matter with the above-mentioned employee urgently!" & vbNewLine & _
    "Kind Regards," & vbNewLine & _
    "COVID-19 Monitoring Team"
    
    On Error Resume Next
    With xOutMail
    .To = "bmetsebeth@buckman.com"
    .Subject = "Employee Health Alert - C2 "
    .Body = xMailBody
    .Display 'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

 

[Barbra090910]

Thank you.

Will this thread send out emails automatically if the cell value changes, even if excel is closed?

 

[maras]

If Excel is closed then "Worksheet_Change" does not work.
Best regards.