时间戳

首页 > 解决方案 > 任务标记为完成时如何停止代码发送电子邮件？

excel - 任务标记为完成时如何停止代码发送电子邮件？

问题描述

以下代码适用于在逾期 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

标签： excelvba

解决方案

在你的循环中，放置一个 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

编辑1：

更新以使用您的代码：

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

推荐阅读