Send Outlook email if criterias are met in Excel cells - excel

Question

I need to send an email with Excel with two conditions.
Cell D2 must be >= 1
Cell E2 must be ="".
I've the first condition done, but not the second one
The code is:
'PRAZO Etapa 4
Public Sub EnviarEmailEt4()
Dim OutApp As Object
Dim OutMail As Object
Dim Body As String
Worksheets("Incidentes2019").Select
Range("D4").Select
Do While ActiveCell.Value <> ""
If ActiveCell >= 1 And ActiveCell.Offset(0, 1) = "" And InStr(2, Cells(ActiveCell.Row, 10), "#") > 0 Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Cells(ActiveCell.Row, 10).Value
.CC = Cells(ActiveCell.Row, 11).Value
.BCC = ""
.Subject = Cells(ActiveCell.Row, 3).Value
If (ActiveCell = 1) Or (ActiveCell = 2) Then
.Body = "ALERTA PRAZO ETAPA 4!!" & vbNewLine & vbNewLine & "Nº GQE " & Cells(ActiveCell.Row, 2).Value & " - " & Cells(ActiveCell.Row, 3).Value
ElseIf (ActiveCell >= 3) Then
.Body = "ULTRAPASSADO PRAZO ETAPA 4!!" & vbNewLine & vbNewLine & "Nº GQE " & Cells(ActiveCell.Row, 2).Value & " - " & Cells(ActiveCell.Row, 3).Value
End If
.Send 'Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox "Alerta Etapa 4 enviado - " & Format(Now, "HH:MM") & vbNewLine & Cells(ActiveCell.Row, 3).Value
End If
Cells(ActiveCell.Row + 1, ActiveCell.Column).Select
Loop
End Sub

Answer 1

Try this, you can check in a loop outside the mail procedure if the cells meet your criteria, if so then you send the mail:
Option Explicit
Sub SendingMails()
Dim ws As Worksheet 'always declare worksheets and workbooks to avoid using select
Dim SendTo As String, SendSubject As String, FirstData As String, SecondData As String 'here, variables for the items to fill on your mail
Dim LastRow As Long, i As Long 'Here you have the lastrow of the worksheet and another variable for a loop
Set ws = ThisWorkbook.Sheets("Sheet1") 'Change Sheet1 for the name of the sheet where you keep the data
With ws
LastRow = .Cells(.Rows.Count, 4).End(xlUp).Row 'this will check the last row with data on the column 4 (D)
For i = 2 To LastRow 'starting from row 2 to the last one with data
If .Cells(i, 4) >= 1 And .Cells(i, 5) <> vbNullString Then 'here you check if column D cell has 1 or higher and if column E cell is empty
SendTo = .Cells(i, 10)
SendSubject = .Cells(i, 3)
FirstData = .Cells(i, 2)
SecondData = .Cells(i, 3)
Call EnviarEmailEt4(SendTo, SendSubject, FirstData, SecondData)
End If
Next i
End With
End Sub
Sub EnviarEmailEt4(SendTo As String, SendSubject As String, FirstData As String, SecondData As String)
'as you can see above, i've declared variables inside the procedure which will be taken from the previous one
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = SendTo
.CC = ""
.BCC = ""
.Subject = SendSubject
.Body = "ALERTA FIM DE PRAZO ETAPA 4!!" & vbNewLine & vbNewLine & "Nº GQE " & FirstData & " - " & SecondData
'.Attachments.Add ActiveWorkbook.FullName 'Anexar este ficheiro
'.Attachments.Add ("") 'Anexar outro ficheiro
.send 'Display
End With
Set OutMail = Nothing
Set OutApp = Nothing
MsgBox " Alerta Et4 enviado - " & Format(Now, "HH:MM") 'I Would avoid alerting in each loop if there are lots of mails
End Sub

Answer 2

You can select cell on the right (like pressing the arrow in excel) using Range.offset() property. Try to change your IF statement to the following:
If ActiveCell >= 1 And ActiveCell.Offset(0, 1) <> "" Then
EDIT:
in response to the change in your question: here is a working approach to set mailbody based on the activecell value:
If (ActiveCell = 1) Or (ActiveCell = 2) Then
MailBody = "ALERTA PRAZO ETAPA 4!!" & vbNewLine & vbNewLine & "Nº GQE " & Cells(ActiveCell.Row, 2).Value & " - " & Cells(ActiveCell.Row, 3).Value
ElseIf (ActiveCell >= 3) Then
MailBody = "ULTRAPASSADO PRAZO ETAPA 4!!" & vbNewLine & vbNewLine & "Nº GQE " & Cells(ActiveCell.Row, 2).Value & " - " & Cells(ActiveCell.Row, 3).Value
End If