Как отправить электронное письмо, если срок выполнения истек в Excel?
Как показано на скриншоте ниже, если срок выполнения в столбце C меньше или равен 7 дням (например, текущая дата — 2017/9/13), электронное письмо отправляется указанному получателю в столбце A, а указанное содержимое из столбца B отображается в теле письма. Как это можно сделать? В этой статье представлен код VBA, который поможет вам выполнить эту задачу.
Отправка электронного письма при наступлении срока с помощью кода VBA
Отправка электронного письма при наступлении срока с помощью кода VBA
Пожалуйста, следуйте указаниям ниже, чтобы отправить напоминание по электронной почте, если срок выполнения наступил в Excel.
1. Нажмите клавиши Alt + F11 одновременно, чтобы открыть окно Microsoft Visual Basic for Applications.
2. В окне Microsoft Visual Basic for Applications нажмите Вставить > Модуль. Затем скопируйте и вставьте приведенный ниже код 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 означает, что срок выполнения должен быть больше 1 дня и меньше или равен 7 дням. Вы можете изменить её по своему усмотрению.
3. Нажмите клавишу F5 для запуска кода. В первом появившемся диалоговом окне Kutools for Excel выберите диапазон столбца с датами выполнения и нажмите кнопку ОК. Смотрите скриншот:
4. Затем появится второе диалоговое окно Kutools for Excel, выберите соответствующий диапазон столбца, содержащий адреса электронной почты получателей, и нажмите кнопку ОК. Смотрите скриншот:
5. В последнем диалоговом окне Kutools for 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-дневная полнофункциональная пробная версия — без регистрации и кредитной карты
- Лучшее соотношение цены и качества — экономия по сравнению с покупкой отдельных надстроек