Как остановить код от отправки электронной почты, когда задача помечена как выполненная?

Question

Следующий код работает для отправки электронных писем за 7 дней до или более позднего срока, но для его запуска необходимо назначить кнопку в Excel. Когда файл открывается, я хочу, чтобы он автоматически запускал код и отправлял электронные письма тем, у кого есть предстоящие или просроченные задачи. Необходимо прекратить отправку электронных писем, где задачи помечены как «Завершенные».

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

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

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

    Set OutApp = CreateObject("Outlook.Application")

     For i = 2 To lRow

         If Cells(i, 5) <> "" Then

             toDate = Replace(Cells(i, 5), ".", "/")

             If Left(Cells(i, 18), 5) <> "Mail" And toDate - Date <= 7 Then
                 Set OutApp = CreateObject("Outlook.Application")
                 Set OutMail = OutApp.CreateItem(0)

                 toList = Cells(i, 7)
                 eSubject = "ACTION ITEM - " & Cells(i, 3) & " is due on " & Cells(i, 5)
                 eBody = "NOTICE for " & Cells(i, 6) & vbCrLf & vbCrLf & "You have task(s)coming due or ones that are past due. Please complete your tasks as soon as possible, then notify the Quality Administrator when the task is complete."

                 On Error Resume Next
                 With OutMail
                     .To = toList
                     .CC = ""
                     .BCC = ""
                     .Subject = eSubject
                     .Body = eBody
                     .bodyformat = 1
                     '.Display
                     .Display
                 End With

                 On Error GoTo 0
                 Set OutMail = Nothing
                 Set OutApp = Nothing
                 Cells(i, 9) = "Mail Sent " & Date + Time
             End If

         End If

     Next i

     ActiveWorkbook.Save

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

 End Sub

Answer 1

внутри вашего цикла, поместите оператор if ... исправьте ссылку на ячейку:

For i = 2 To lRow
    If Cells(i,1).value <> "Completed" Then 'could also use Not Cells(i,1).value = "Completed"
        'all of your regular code
    End If
Next i

---

Edit1:

Обновите для использования вашегокод:

For i = 2 To lRow
    If Cells(i,1).value <> "Completed" Then 'OPEN IT HERE
        If Cells(i, 5) <> "" Then
            toDate = Replace(Cells(i, 5), ".", "/")
            If Left(Cells(i, 18), 5) <> "Mail" And toDate - Date <= 7 Then
                Set OutApp = CreateObject("Outlook.Application")
                Set OutMail = OutApp.CreateItem(0)
                toList = Cells(i, 7)
                eSubject = "ACTION ITEM - " & Cells(i, 3) & " is due on " & Cells(i, 5)
                eBody = "NOTICE for " & Cells(i, 6) & vbCrLf & vbCrLf & "You have task(s)coming due or ones that are past due. Please complete your tasks as soon as possible, then notify the Quality Administrator when the task is complete."
                On Error Resume Next
                With OutMail
                    .To = toList
                    .CC = ""
                    .BCC = ""
                    .Subject = eSubject
                    .Body = eBody
                    .bodyformat = 1
                    '.Display
                    .Display
                End With
                On Error GoTo 0
                Set OutMail = Nothing
                Set OutApp = Nothing
                Cells(i, 9) = "Mail Sent " & Date + Time
            End If
        End If
    End If 'CLOSE IT HERE
Next i

Второй способ сделать это, используя существующее утверждение If:

For i = 2 To lRow
    If Cells(i, 5) <> "" Or Cells(i,1).value <> "Completed" Then
        toDate = Replace(Cells(i, 5), ".", "/")
        If Left(Cells(i, 18), 5) <> "Mail" And toDate - Date <= 7 Then
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            toList = Cells(i, 7)
            eSubject = "ACTION ITEM - " & Cells(i, 3) & " is due on " & Cells(i, 5)
            eBody = "NOTICE for " & Cells(i, 6) & vbCrLf & vbCrLf & "You have task(s)coming due or ones that are past due. Please complete your tasks as soon as possible, then notify the Quality Administrator when the task is complete."
            On Error Resume Next
            With OutMail
                .To = toList
                .CC = ""
                .BCC = ""
                .Subject = eSubject
                .Body = eBody
                .bodyformat = 1
                '.Display
                .Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
            Set OutApp = Nothing
            Cells(i, 9) = "Mail Sent " & Date + Time
        End If
    End If
Next i