Функция if и elseif для выполнения ".Body" - PullRequest
0 голосов
/ 22 марта 2019

image

Поэтому мне нужно выполнить «.Body» с помощью функции if и elseif, когда электронное письмо отправляется через Excel (макрос в 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
            .CC = Cells(ActiveCell.Row, 11).Value
            .BCC = ""
            .Subject = Cells(ActiveCell.Row, 3).Value
            .Body = 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 If

    Cells(ActiveCell.Row + 1, ActiveCell.Column).Select

    Loop
End Sub

Ответы [ 2 ]

3 голосов
/ 22 марта 2019

В таком случае вам понадобится что-то подобное.

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

Редактировать 1:

Оператор with должен выглядеть следующим образом:

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
End With
0 голосов
/ 22 марта 2019

Вы задали точно такой же вопрос неделю назад.И ошибка в вашем коде с прошлой недели была точно такой же, как этот вопрос.Я не понимаю, как вам удалось получить положительный голос.

"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.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...