Send an email when a check box is selected

[BaconBob]

I'm using Excel 2016 to register guests in at a Trade Show. (I know it may not be the best option, but no budget for other software)
The trick is, I'm trying to find a way to notify a sales rep when one of their VIP's arrive.
SMS would be ideal, but understand email may be the best option.
Spreadsheet contains: customer name, company; Sales rep name (we can change to email address)
and a column to confirm the customer has attended the event.

I am not a developer, just a user doing some research.

Thank you,

 

[Logit]

.
Here is a link to the following project :

https://www.amazon.com/clouddrive/share/24ZLsdPYcQ7JSykYwuvbXfUhkG5EE6gd3LODETklbi6

Option Explicit


Sub eMail()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList As String
Dim eSubject As String
Dim eBody As String
Dim OutApp, OutMail As Object


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


Sheets(1).Select
lRow = Cells(Rows.Count, 4).End(xlUp).Row


For i = 2 To lRow
'toDate = Replace(Cells(i, 3), ".", "/")
  'If Cells(i, 3) = Now Then
     Set OutApp = CreateObject("Outlook.Application")
     Set OutMail = OutApp.CreateItem(0)


        toList = Cells(i, 4)    'gets the recipient from col D
        eSubject = "Your VIP Client " & Cells(i, 2) & " participated in the recent Trade Show. " '& Cells(i, 3)
        eBody = "Dear " & Cells(i, 1) & vbCrLf & vbCrLf & "Just a quick note to advise your VIP Client's status at the show." & vbCrLf & vbCrLf & vbCrLf & _
        "Sincerely, " & vbCrLf & vbCrLf & _
        "Tom Banks "
        
        On Error Resume Next
        With OutMail
        .To = toList
        .CC = ""
        .BCC = ""
        .Subject = eSubject
        .Body = eBody
        '.bodyformat = 1
        .Display   ' ********* Creates draft emails. Comment this out when you are ready
        '.Send     '********** UN-comment this when you  are ready to go live
        End With
 
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
 Cells(i, 5) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column A"
'End If
Next i


ActiveWorkbook.Save


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

 

[BaconBob]

This is great. Thank you.
I did a test on this, and one thing I noticed in testing, If I add other VIP's an reps, when I click on the send Email button, emails are created for all, not just for the records.
Also, is there a way that we can flag some customers as VIP, as our reps will invite many people but only have a few that are VIP.

 

[Logit]

.
Sheet 1 contains the check-in / email info. You are given ten rows of accumulated check-ins, at which time you need to send the emails or lose anything that was entered after the ten rows.
I am presuming you will most likely enter two or three different clients at check-in then send the emails.

When the emails are sent, Sheet 1 is cleared of all entries and the data is transferred to Sheet 2 for a permanent record. As new emails are sent, the new entries on Sheet 2 are added below
the previously entered data.

There is another column (F) for tracking if the client was a VIP.

Sub eMail()
Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList As String
Dim eSubject As String
Dim eBody As String
Dim OutApp, OutMail As Object


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


Sheets(1).Select
lRow = Cells(Rows.Count, 4).End(xlUp).Row


For i = 2 To lRow
'toDate = Replace(Cells(i, 3), ".", "/")
  'If Cells(i, 3) = Now Then
     Set OutApp = CreateObject("Outlook.Application")
     Set OutMail = OutApp.CreateItem(0)


        toList = Cells(i, 4)    'gets the recipient from col D
        eSubject = "Your VIP Client " & Cells(i, 2) & " participated in the recent Trade Show. " '& Cells(i, 3)
        eBody = "Dear " & Cells(i, 1) & vbCrLf & vbCrLf & "Just a quick note to advise your VIP Client's status at the show." & vbCrLf & vbCrLf & vbCrLf & _
        "Sincerely, " & vbCrLf & vbCrLf & _
        "Tom Banks "
        
        On Error Resume Next
        With OutMail
        .To = toList
        .CC = ""
        .BCC = ""
        .Subject = eSubject
        .Body = eBody
        '.bodyformat = 1
        .Display   ' ********* Creates draft emails. Comment this out when you are ready
        '.Send     '********** UN-comment this when you  are ready to go live
        End With
  Cells(i, 5) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column A"


    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
'End If
Next i


ActiveWorkbook.Save
cpypaste


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


Sub cpypaste()


    Dim wsM As Worksheet
    Set wsM = Sheets("Sheet2")
    
    '
    Sheets("Sheet1").Range("A2:F10").Copy Destination:=wsM.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    Sheets("Sheet1").Range("A2:F10").Value = ""
   
End Sub

Download link: https://www.amazon.com/clouddrive/share/sxALVxtsozl2RptvPCQtvLWgga5t2iv4o3iaUM9x5cw

 

[BaconBob]

@Logit, Thank you very much for your help. This will help me and my team out a lot.
Kudos to you.

 

[Logit]

.
Thanks ! Trust it works well for your needs.