Вы задали точно такой же вопрос неделю назад.И ошибка в вашем коде с прошлой недели была точно такой же, как этот вопрос.Я не понимаю, как вам удалось получить положительный голос.
"x = если a, то что-то еще" не действует в VBA.Заставляет меня задуматься, написал ли ты этот код.
Но что угодно.Вот рабочая версия.
Sub EnviarEmailEt4()
Dim OutApp As Object
Dim OutMail As Object
Dim Body As String
Range("D2").Select
Do While ActiveCell.Value <> ""
If ActiveCell >= 1 And ActiveCell.Offset(0, 1) = "" And InStr(4, Cells(ActiveCell.Row, 10), "@") > 0 Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Cells(ActiveCell.Row, 10).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
End With
End If
Cells(ActiveCell.Row + 1, ActiveCell.Column).Select
Loop
End Sub
Кстати, вы никогда не отправляете письмо с этим кодом.Для этого вам нужно добавить OutMail.send
.