Как настроить электронную почту для отправки через Excel для проектов, которые должны быть выполнены в течение 7 дней?

Question

Изображение электронной таблицы

Я пытаюсь настроить уведомления по электронной почте для отправки людям в моем отделе, когда наступает срок в течение 7 дней. В настоящее время проблема заключается в том, что всякий раз, когда я запускаю модуль, он настраивает электронную почту для всего, что находится до срока оплаты. Однако я хочу настроить электронную почту для проектов, которые должны быть выполнены в течение 7 дней. Таким образом, если срок выполнения проекта составляет 10 дней, я не хочу, чтобы письмо отправлялось, тот же проект, где он уже просрочен.

Кроме того, я хотел бы, чтобы электронные письма были отправлены лицу, ответственному за проект, но не если они указали, что они уже завершили проект в колонке I.

У меня есть имена проектов в столбце B, электронные письма в столбце F, сроки выполнения в столбце H, а в столбце K будет отображаться «Отправлено по электронной почте», если скрипт отправит электронное письмо. Если электронное письмо уже было отправлено ранее, оно пропустит эту строку.

Private Sub Workbook_Open()
        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")
        OutApp.Session.Logon

        ' Change the following as needed
        sSendCC = ""
        sSendBCC = ""
        sSubject = "Project Log Due Date Reached"

        lLastRow = Cells(Rows.Count, 3).End(xlUp).Row
        For lRow = 3 To lLastRow
            If Cells(lRow, 11) <> "Email Sent" Then
                If Cells(lRow, 8) - Date <= 7 And Cells(1Row, 8) - Date > 0 Then
                    Set OutMail = OutApp.CreateItem(0)

                    On Error Resume Next
                    With OutMail
                        .To = Cells(1Row, 6) 
                        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
                        ' Assumes project name is in column B
                        sTemp = sTemp & "    " & Cells(lRow, 2)
                        sTemp = sTemp & "Please take the appropriate"
                        sTemp = sTemp & "action." & vbCrLf & vbCrLf
                        sTemp = sTemp & "Thank you!" & vbCrLf

                        .Body = sTemp
                        ' Change the following to .Send if you want to
                        ' send the message without reviewing first
                        .Send
                    End With
                    Set OutMail = Nothing

                    Cells(lRow, 11) = "Email Sent"
                    Cells(lRow, 12) = "E-mail sent on: " & Now()
                End If
            End If
        Next lRow
        Set OutApp = Nothing
    End Sub

Answer 1

Пожалуйста, сделайте вспомогательный столбец в свободном столбце, скажем L, поместите формулу =TODAY()-G2 и нарисуйте.Замените ваши следующие строки

  For lRow = 3 To lLastRow
        If Cells(lRow, 10) <> "Email Sent" Then
            If Cells(lRow, 7) <= 7 Then
  Set OutMail = OutApp.CreateItem(0)

на

For lRow = 3 To lLastRow
     If Cells(lRow, 10) <> "Email Sent" Then   
         If (Cells(lRow, 12) >= -7) And (Cells(lRow, 12) <= 0) Then
 Set OutMail = OutApp.CreateItem(0)

Это работает для меня.Вы также можете следовать любой другой логике, основанной на этой логике.

Answer 2

Seany, Скотт прав - уберите оператор «On Error Resume Next», так как он подавляет ошибки, которые вы предпочитаете видеть, и устраняет их во время разработки.И вы сказали столбец F;который при использовании свойства Cells, столбец является вторым параметром, и у вас есть «7», где «F» будет «6».

Для сравнения дат я бы предложил DateDiff

Пример:

DateDiff("d", ws.Cells(1, 1).Value, ws.Cells(1, 1).Value + 7)