Попытка отправить разные сообщения Outlook в зависимости от того, находится ли «0» в столбцах C, D и E рядом с электронной почтой.

Question

Я пытаюсь автоматизировать электронные письма для доставки, требуемой моей командой с макросом. В Excel у меня есть Имя в столбце A, электронная почта в столбце B, а столбцы C и D указывают, получил ли я информацию KPI, комментарии и организационную диаграмму от группы.
выборка данных

Я пытаюсь использовать и If Then Else statement, чтобы зациклить столбцы C, D и E и отправить электронное письмо, если значение в этих ячейках равно "0"

Получение Else без ошибки IF, хотя я постарался распределить операторы в соответствии с их конкретными правилами.

Честно говоря, я не уверен, что утверждение If Then Else - это то, что мне нужно, чтобы мой макро-цикл состоял из трех столбцов и отправлял электронные письма контактному лицу в строке с просьбой указать элемент с "0" в клетке

Sub EMail()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMailKPI As Object
    Dim OutmailComment As Object
    Dim OutmailOrg As Object
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)

    If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "C").Value) = "0" Then

            Set OutMailKPI = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "Reminder"
                .Body = "Dear, " & Cells(cell.Row, "A").Value _
                      & vbNewLine & vbNewLine & _
                        "KPI"
                '.Attachments.Add ("C:\test.txt")
                .Send  'Or use Display

    Else

        Columns("B").Cells.SpecialCells (xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "D").Value) = "0" Then

            Set OutmailComment = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "Reminder"
                .Body = "Dear, " & Cells(cell.Row, "A").Value _
                      & vbNewLine & vbNewLine & _
                        "Comment"
                '.Attachments.Add ("C:\test.txt")
                .Send  'Or use Display

            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Если у меня есть и KPI, и Комментарии, но нет диаграммы Org, когда я запускаю только макрос, и этому контакту будет отправлено электронное письмо с телом "Пожалуйста, отправьте диаграмму Org".

Я укажу, получил ли я элемент с 0 в ячейке под каждым column labeled:KPI, Comments,OrgChart.

Answer 1

Попробуйте следующее

Option Explicit
Public Sub EMail()
    Application.ScreenUpdating = False

    Dim OutApp As Object
    Set OutApp = CreateObject("Outlook.Application")

    Dim Sht As Worksheet
    Set Sht = ThisWorkbook.Sheets("Sheet1")

    Dim Cell As Range
    For Each Cell In Sht.Range("A2", Sht.Range("A100").End(xlUp))
        DoEvents

       If Sht.Cells(Cell.Row, "B").Value Like "?*@?*.?*" And _
           Sht.Cells(Cell.Row, "C").Value = "0" Or _
           Sht.Cells(Cell.Row, "D").Value = "0" Or _
           Sht.Cells(Cell.Row, "E").Value = "0" Then               

            Dim MissingItem As String
            Select Case "0"
                Case Sht.Cells(Cell.Row, "C").Value
                    MissingItem = "KPI's"
                Case Sht.Cells(Cell.Row, "D").Value
                    MissingItem = "Comments"
                Case Sht.Cells(Cell.Row, "E").Value
                    MissingItem = "Org Chart"
            End Select

            Dim OutMailKPI As Object
            Set OutMailKPI = OutApp.CreateItem(0)

            With OutMailKPI
                .To = Sht.Cells(Cell.Row, "B").Value
                .Subject = "Reminder"
                .Body = "Dear, " & Sht.Cells(Cell.Row, "A").Value _
                      & vbNewLine & vbNewLine & MissingItem
                .Display
            End With

        End If
    Next Cell

    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub