CODEWITHSUNDEEP
excelvbaoutlook
Tatiana Martins
Tatiana Martins

Reputation: 7

Send Outlook email if criterias are met in Excel cells

I need to send an email with Excel with two conditions.

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

Upvotes: 0

Views: 1186

Answers (2)

FFFffff
FFFffff

Reputation: 1045

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

Upvotes: 0

Damian
Damian

Reputation: 5174

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

Upvotes: 1

Related Questions