когда критерии не соответствуют ничего не делать Excel VBA макрос

Question

Я реализую макрос, который проверяет столбец E на даты, которые находятся на 7 дней от текущей даты.

If cell date - current date = 7

затем электронное письмо, содержащее строку с соответствующей ячейкой, отправляется на адрес электронной почты для уведомления.

Это мое кодирование, оно работает успешно, за исключением одного вопроса.

Sub Workbook_Open()

Dim rngStart As Range
Dim rngEnd As Range
Dim rngCell As Range
Dim strHtmlHead As String
Dim strHtmlFoot As String
Dim strMsgBody As String
Dim strMsg As String
Dim objEmail As Object
Dim OutlookApp As Object
Dim OutlookMail As Object

'On Error GoTo ErrHnd

'only run if between midnight and 2AM
'If Hour(Now) < 2 Then

'setup basic HTML message header and footer


'setup start of body of message
strMsgBody = "The following task(s) are due in less than 7 days :"

'Worksheet name
With Worksheets("Sheet1")
'set start of date range
Set rngStart = .Range("E1")
'find end of date range
Set rngEnd = .Range("E" & CStr(Application.Rows.Count)).End(xlUp)

'loop through all used cells in column G
For Each rngCell In .Range(rngStart, rngEnd)
'test if date is equal to 7 days from today
If IsDate(rngCell.Value) Then
If rngCell.Value - Int(Now) = 7 Then
'add to message - use task name from column A (offset -3)
'change as required
strMsgBody = strMsgBody & "
" & "
" & "Task: " & rngCell.Offset(0, -3).Text _
& " is due on " & rngCell.Text & "
" & "
" & "Therefore please take necessary action"
End If
End If
Next rngCell

'Note last test time/date
rngEnd.Offset(1, -3) = Now
rngEnd.Offset(1, -3).NumberFormat = "dd/mm/yy"
End With

'put message together
strMsg = strMsgBody

'test message
'MsgBox strMsg

'create the e-mail object


Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

With OutlookMail

.To = "adrianadriananthony@outlook.com"
.CC = ""
.BCC = ""
.Subject = "Task Alert"
.HTMLBody = strMsg
.Send
End With


Set OutlookMail = Nothing
Set OutlookApp = Nothing

Application.DisplayAlerts = True
Application.ScreenUpdating = True


'remove the e-mail object

Exit Sub

'error handler
ErrHnd:
Err.Clear

End Sub

Работает успешно, за исключением одного вопроса. Когда никакие даты не соответствуют критериям

 rngCell.Value - Int(Now) = 7

Электронное письмо по-прежнему генерируется без указания каких-либо задач. я хочу отредактировать код так, чтобы при отсутствии дат, удовлетворяющих следующим критериям, электронное письмо не отправлялось

rngCell.Value - Int(Now) = 7

Как я могу достичь этого?

Answer 1

Создайте логическую переменную, установите ее в false перед циклом и измените ее на true только тогда, когда сравнение дат истинно. Затем, перед отправкой электронного письма, проверьте состояние переменной. Вы можете сделать эти изменения:

1 - Перед циклом, над линией For Each rngCell In .Range(rngStart, rngEnd) ставит строку ValidDate = False .

2 - После If rngCell.Value - Int(Now) = 7 Then поместите строку ValidDate = True .

3 - Перед строкой Set OutlookApp = CreateObject("Outlook.Application") поставить строку: If ValidDate = True Then

4- Закройте блок if после .Send End With End If строки, если .