Including specific excel data into an automated Outlook Email

[taj002]

Hello,

I have been trying to set up an automated email system based on expiration dates of research supplies. I have set up a code in VBA that can send out an email to the appropriate employees based upon when the supplies have expired. I would now like to include specific cell data from excel in the email. For example, I would like the email to read "Hello replace_name_here! This is a reminder that there are replace_kit_quantity_here kits in the study, replace_study_name_here (replace_kit_type_here) that are expiring on replace_expiration_date_here. Be sure to arrange any necessary reordering that you need to. I will be pulling the boxes from the shelf and destroying them upon expiration. Please let me know of any concerns. Thanks!"

The excel data is in the following columns:

name - ("H")
kit_quantity - ("D")
kit_type - ("C")
study_name- ("A")
expiration_date - ("E")

The code that I have set up is below. I just need to link up the necessary spots in the body of the message with the corresponding excel data. If anyone can help me write a code for it, I would appreciate it!

Sub SendReminderMail()
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim iCounter As Integer
Dim MailDest As String

Set OutLookApp = CreateObject("Outlook.Application")

Set OutLookMailItem = OutLookApp.CreateItem(0)

With OutLookMailItem
MailDest = ""
For iCounter = 1 To WorksheetFunction.CountA(Columns(7))
If MailDest = “” And Cells(iCounter, 7).Offset(0, -1) = "EXPIRING OR EXPIRED" Then
MailDest = Cells(iCounter, 7).Value
ElseIf MailDest <> "" And Cells(iCounter, 7).Offset(0, -1) = "EXPIRING OR EXPIRED" Then
MailDest = MailDest & ";" & Cells(iCounter, 7).Value
End If
Next iCounter

.BCC = MailDest
.Subject = "Expiring Kits"
.Body = "Hello replace_name_here! This is just a reminder that there are some kits that are about to expire in your study. Be sure to arrange any necessary reordering that you need to. I will be pulling the boxes from the shelf and destroying them upon expiration. Please let me know of any concerns. Thanks! Trent"
.Send
End With

Set OutLookMailItem = Nothing
Set OutLookApp = Nothing
End Sub

 

[Rijnsent]

Hi Taj,
check out the Replace function in VBA. E.g.:

Dim BodyTxt as String
BodyTxt = ""Hello replace_name_here! This is a reminder that there are replace_kit_quantity_here kits in the study."
BodyTxt = Replace(BodyTxt , "replace_name_here", "Leo")
BodyTxt = Replace(BodyTxt , "replace_kit_quantity_here", Cells(iCounter, 23).Value)

'And later on:
.Body = BodyTxt

More help here: https://www.techonthenet.com/excel/formulas/replace_vba.php
Cheers,
Koen