personalised emails

[taj002]

Hello,

I have a code that sends out an email to employees once materials have expired. I am trying to personalize the email so that it says "hello (name!)" then later in the body I want it to list out the information about their materials that are expiring. Below is the information based on the columns that I have it in and this is the info I want to be displayed in the body of an email (further below is my entire code). If anyone can modify my code to display this information i would greatly appreciate it! Thanks

mail_body_message = ("L5")
full_name = ("H")
kit_quantity = ("D")
kit_type = ("C")
protocol = ("A")
protocol_number =("B")
expiration_date = ("E")


CODE:

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

 

[JazzSP8]

Hi - Welcome to the Forum

Assuming your emails are formatted in the normal way (like jazz.sp8@mrexcel.com)

Then try;

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
        PersonName = WorksheetFunction.Proper(Left(Cells(iCounter, 7).Value, WorksheetFunction.Find(".", Cells(iCounter, 7).Value) - 1))
    ElseIf MailDest <> "" And Cells(iCounter, 7).Offset(0, -1) = "EXPIRING OR EXPIRED" Then
        MailDest = MailDest & ";" & Cells(iCounter, 7).Value
        PersonName = WorksheetFunction.Proper(Left(Cells(iCounter, 7).Value, WorksheetFunction.Find(".", Cells(iCounter, 7).Value) - 1))
    End If

    Next iCounter
 
    .BCC = MailDest
    .Subject = "Expiring Kits"
    .Body = "Hello" & PersonName & "! 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

If that isn't the case then if you could let us know how the names are formatted in your worksheet then that'd be good

 

[taj002]

Thank you, but I want to add the info about the name, protocol, protocol number, kit type, and expiration date as well. Will this follow the exact same format as what you did for the name? Could you maybe add that info into my code based on their respective columns as I have shown above? Thank you!

 

[taj002]

Hello,

I am getting a typed mismatch error with the PersonName = WorksheetFunction.Proper(Right(Cells(iCounter, 7).Value, WorksheetFunction.Find(".", Cells(iCounter, 7).Value + 1))) line. My names are in column H, to the right of the column with the emails in them. Any idea what this mismatched error is about? Thanks!