quando os critérios não coincidem não fazem nada com macro vba

Question

Estou implementando uma macro que verifica a coluna E quanto a datas que estão a 7 dias da data atual.

If cell date - current date = 7

um e-mail contendo a linha que tem a célula correspondente é enviado para um endereço de e-mail para ser notificado.

Este é o meu código que funciona com sucesso, exceto por um problema.

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 = "[email protected]"
.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

Funciona com sucesso, exceto por um problema. Quando nenhuma data cumpre os critérios

 rngCell.Value - Int(Now) = 7

Um email ainda é gerado sem especificar nenhuma tarefa. Eu quero editar o código para que nenhum email seja enviado quando não houver datas preenchendo os seguintes critérios

rngCell.Value - Int(Now) = 7

Como posso conseguir isso?

    

Answer 1

Crie uma variável booleana, defina-a como false antes do loop e altere-a para true apenas quando a comparação das datas for verdadeira. Então, antes de enviar o email, verifique o estado da variável. Você pode fazer essas alterações:

1 - Antes do loop , acima da linha For Each rngCell In .Range(rngStart, rngEnd) coloque a linha ValidDate = False .

2 - Depois de If rngCell.Value - Int(Now) = 7 Then colocar a linha ValidDate = True .

3 - Antes da linha Set OutlookApp = CreateObject("Outlook.Application") colocar a linha: If ValidDate = True Then

4- Feche o bloco if colocando após .Send End With a linha End If .