时间戳

首页 > 解决方案 > 尝试根据“0”是否在电子邮件旁边的 C、D 和 E 列中发送不同的 Outlook 邮件

excel - 尝试根据“0”是否在电子邮件旁边的 C、D 和 E 列中发送不同的 Outlook 邮件

问题描述

我正在尝试使用宏来自动化我的团队所需的可交付电子邮件。在 Excel 中，我在 A 列中有名称，B 列中有电子邮件，C 列和 D 列表示我是否收到了来自团队的 KPI 信息以及评论和组织结构图。
数据样本

在此处输入图像描述

我正在尝试使用并If Then Else statement循环 C、D 和 E 列，如果这些单元格中的值为"0"

即使我确保根据特定规则将语句隔开，但得到没有 IF 错误的 Else。

坦率地说，我不确定 If Then Else 语句是否是我需要让我的宏循环通过三列并向行中的联系人发送电子邮件，询问"0"单元格中带有 a 的项目

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 和评论但没有组织结构图，并且正文“请发送组织结构图”的电子邮件将发送给该​​联系人。

column labeled:KPI我会指出我是否收到了在每个,下的单元格中带有 0 的项目Comments,OrgChart。

标签： excelvbaoutlook

解决方案

尝试以下

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

推荐阅读