Auto send email to multiple recipients

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

score 0 · Answer 1 · answered Aug 29 '19 at 04:34

0

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

answered Aug 29 '19 at 04:34

TedZheng

52
3

It doesnt solve it.. ive change the line .Display to .Display(True) and it works but only for the first email that pops out.. ive created a new question for this, tq for your help !... the question is https://stackoverflow.com/questions/57764671/runtime-error-vba-excel-for-email-automation – Arepeel Sep 03 '19 at 06:51

Auto send email to multiple recipients

1 Answers1