Как отправить электронное письмо, если выполнено условие «Срок выполнения» в Excel?
Как показано на снимке экрана ниже, если дата в столбце C наступает через срок выполнения, составляющий 7 дней или меньше (например, текущая дата — 13,09.2017), указанному получателю из столбца A отправляется электронное письмо, а текст из столбца B включается в его тело. Как этого добиться? В этой статье приведён код VBA, который поможет вам решить эту задачу.
Отправка электронного письма при выполнении условия Срок выполнения с помощью кода VBA
Отправка электронного письма при выполнении условия Срок выполнения с помощью кода VBA
Выполните следующие действия, чтобы отправить напоминание по электронной почте при наступлении срока выполнения в Excel.
1. Нажмите одновременно клавиши Alt+F11, чтобы открыть окно Microsoft Visual Basic для приложений.
2. В окне Microsoft Visual Basic для приложений выберите Вставка > Модуль. Затем скопируйте и вставьте приведённый ниже код VBA в окно модуля.
Код VBA: отправка электронного письма при закрытии книги Срок выполнения в Excel
Public Sub CheckAndSendMail()
'Updated by Extendoffice 2018/11/22
Dim xRgDate As Range
Dim xRgSend As Range
Dim xRgText As Range
Dim xRgDone As Range
Dim xOutApp As Object
Dim xMailItem As Object
Dim xLastRow As Long
Dim vbCrLf As String
Dim xMailBody As String
Dim xRgDateVal As String
Dim xRgSendVal As String
Dim xMailSubject As String
Dim i As Long
On Error Resume Next
Set xRgDate = Application.InputBox("Please select the due date column:", "KuTools For Excel", , , , , , 8)
If xRgDate Is Nothing Then Exit Sub
Set xRgSend = Application.InputBox("Please select the recipients?email column:", "KuTools For Excel", , , , , , 8)
If xRgSend Is Nothing Then Exit Sub
Set xRgText = Application.InputBox("Select the column with reminded content in your email:", "KuTools For Excel", , , , , , 8)
If xRgText Is Nothing Then Exit Sub
xLastRow = xRgDate.Rows.count
Set xRgDate = xRgDate(1)
Set xRgSend = xRgSend(1)
Set xRgText = xRgText(1)
Set xOutApp = CreateObject("Outlook.Application")
For i = 1 To xLastRow
xRgDateVal = ""
xRgDateVal = xRgDate.Offset(i - 1).Value
If xRgDateVal <> "" Then
If CDate(xRgDateVal) - Date <= 7 And CDate(xRgDateVal) - Date > 0 Then
xRgSendVal = xRgSend.Offset(i - 1).Value
xMailSubject = xRgText.Offset(i - 1).Value & " on " & xRgDateVal
vbCrLf = "<br><br>"
xMailBody = "<HTML><BODY>"
xMailBody = xMailBody & "Dear " & xRgSendVal & vbCrLf
xMailBody = xMailBody & "Text : " & xRgText.Offset(i - 1).Value & vbCrLf
xMailBody = xMailBody & "</BODY></HTML>"
Set xMailItem = xOutApp.CreateItem(0)
With xMailItem
.Subject = xMailSubject
.To = xRgSendVal
.HTMLBody = xMailBody
.Display
'.Send
End With
Set xMailItem = Nothing
End If
End If
Next
Set xOutApp = Nothing
End SubПримечания: строка If CDate(xRgDateVal) - Date <= 7 And CDate(xRgDateVal) - Date > 0 Then в коде VBA означает, что разница между датами должна быть больше 0 дней и меньше или равна 7 дням. При необходимости вы можете изменить это значение.
3. Нажмите клавишу F5, чтобы запустить код. В первом появившемся диалоговом окне Kutools для Excel выберите диапазон столбца «Срок выполнения», затем нажмите кнопку ОК. См. снимок экрана:
4. Затем появится второе диалоговое окно Kutools для Excel. Выберите соответствующий диапазон столбца, содержащего адреса электронной почты получателей, и нажмите кнопку ОК. См. снимок экрана:
5. В последнем диалоговом окне Kutools для Excel выберите содержимое, которое хотите отобразить в теле письма, и нажмите кнопку ОК.
Когда дата в столбце C наступает через срок выполнения, составляющий 7 дней или меньше, автоматически создаётся электронное письмо с указанными получателем, темой и текстом. Нажмите кнопку Отправить, чтобы отправить письмо.
Примечания:
1. Каждое созданное письмо соответствует одному сроку выполнения. Например, если трём срокам выполнения соответствуют заданные критерии, автоматически создаются три электронных сообщения.
2. Код не запустится, если ни одна из дат не соответствует заданным критериям.
3. Код VBA работает только при условии, что в качестве программы электронной почты используется Outlook.
Раскройте магию Excel с помощью KUTOOLS AI
- Интеллектуальное выполнение: Выполняйте операции с ячейками, анализируйте данные и создавайте диаграммы — всё это доступно через простые команды.
- Пользовательские формулы: создавайте индивидуальные формулы для оптимизации рабочих процессов.
- Программирование на VBA: Пишите и внедряйте код VBA легко и без усилий.
- Анализ формул: Легко разбирайтесь даже в самых сложных формулах.
- Перевод текста: Ломайте языковые барьеры прямо в ваших таблицах.
См. также:
- Как настроить автоматическую отправку электронного письма в зависимости от значения ячейки в Excel?
- Как отправить электронное письмо через Outlook при сохранении книги Excel?
- Как отправить электронное письмо при изменении определённой ячейки в Excel?
- Как отправить электронное письмо одним нажатием кнопки в Excel?
- Как отправить напоминание или уведомление по электронной почте при обновлении книги в Excel?
Лучшие инструменты повышения продуктивности в Office
Раскройте весь потенциал Excel с помощью Kutools для Excel и ощутите эффективность как никогда раньше.Kutools для Excel предлагает более 300 расширенных функций для повышения продуктивности и Экономия времени.Нажмите здесь, чтобы получить нужную Вам функцию…
Office Tab добавляет в Office вкладки и значительно упрощает Вашу работу
- Включите редактирование и чтение во вкладках в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
- Открывайте и создавайте несколько документов во вкладках одного окна — вместо того чтобы использовать отдельные окна.
- Повышает вашу продуктивность на 50 % и экономит сотни кликов мышью каждый день!
Все надстройки Kutools — один установщик
Kutools for Office — набор надстроек для Excel, Word, Outlook и PowerPoint, а также Office Tab Pro, идеально подходящий командам, работающим с разными приложениями Office.
- Единый комплект— надстройки для Excel, Word, Outlook и PowerPoint + Office Tab Pro
- Один установщик, одна лицензия— настройка занимает считанные минуты (готово для MSI)
- Лучше работать вместе— оптимизированная продуктивность во всех приложениях Office
- 30-дневная полнофункциональная пробная версия— без регистрации и кредитной карты
- Лучшее соотношение цены и качества— экономия по сравнению с покупкой отдельных надстроек