Auto send email to multiple recipients - excel

Question

I can send email to multiple recipients with a click of a button in Excel with this code.
The problem comes when marking it with time. If I send email to one recipient the whole column will be marked with the time and mark of that one recipient and ignore the others.
This is my code in Module1 and a class called Class1
This is the code in Module1
Sub Button4_Click()
Dim OutApp As Object
Dim OutMail As Object
Dim lLastRow As Long
Dim lRow As Long
Dim sSendTo As String
Dim sSendCC As String
Dim sSendBCC As String
Dim sSubject As String
Dim sTemp As String
Set OutApp = CreateObject("Outlook.Application")
Set itmevt.itm = Nothing
OutApp.Session.Logon
sSendTo = Range("D3")
sSendCC = ""
sSendBCC = ""
sSubject = "Due date reached"
lLastRow = Cells(Rows.Count, 3).End(xlUp).Row
For lRow = 3 To lLastRow
If Cells(lRow, 5) <> "Email sent" Then
If Cells(lRow, 3) <= Date Then
Set OutMail = OutApp.CreateItem(0)
Set itmevt.itm = OutMail
With OutMail
.To = sSendTo
If sSendCC > "" Then .CC = sSendCC
If sSendBCC > "" Then .BCC = sSendBCC
.Subject = sSubject
sTemp = "Hello!" & vbCrLf & vbCrLf
sTemp = sTemp & "The due date has been reached "
sTemp = sTemp & "for this project:" & vbCrLf & vbCrLf
sTemp = sTemp & " " & Cells(lRow, 2)
sTemp = sTemp & vbCrLf & vbCrLf & " Please take the appropriate"
sTemp = sTemp & " action." & vbCrLf
sTemp = sTemp & "Regards," & vbCrLf
sTemp = sTemp & "Danial " & vbCrLf
.Body = sTemp
.Display
End With
Set OutMail = Nothing
End If
End If
Next lRow
Set OutApp = Nothing
End Sub
This is the code in Class1
Option Explicit
Public WithEvents itm As Outlook.MailItem
Private Sub itm_Close(Cancel As Boolean)
Dim lLastRow As Long
Dim lRow As Long
Dim blnSent As Boolean
On Error Resume Next
blnSent = itm.Sent
lLastRow = Cells(Rows.Count, 3).End(xlUp).Row
For lRow = 3 To lLastRow
If Cells(lRow, 5) <> "Email sent" Then
If Cells(lRow, 3) <= Date Then
If Err.Number = 0 Then
Cells(lRow, 5) = "Email not sent"
Cells(lRow, 6) = "X"
Cells(lRow, 6).Interior.ColorIndex = 38
Else
Cells(lRow, 5) = "Email sent"
Cells(lRow, 6) = Now()
End If
End If
End If
Next lRow
End Sub

Answer 1

Try to sSendTo = Range("D3").value, if it's not worked. Please process the sSendTo=Join(split(range("D3").value,";"),";")