如果单元格包含单词 "expired"，请发送电子邮件

Question

当 F 列中的相应单元格包含文本 "expired" 时，我想使用 excel 从 C5-C42 向 C 列中的电子邮件地址发送电子邮件。我已经在这里待了四天多了。我感谢我能得到的任何帮助。

我也不断收到运行时间错误 424。

下面是我的代码：

Private Sub CommandButton1_Click()
If Target.Cells.Count > 1 Then Exit Sub
    If Not Application.Intersect(Range("F5:F42"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value = "Expired" Then
            Call Mail_small_Text_Outlook
        End If
    End If
End Sub
Sub Mail_small_Text_Outlook()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "Your certification has expired." & vbNewLine & _
              "Please contact an admin."

    On Error Resume Next
    With OutMail
        .To = "emailaddress@net.com"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = strbody

        .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Answer 1

试试这个：

Private Sub CommandButton1_Click()
Dim c As Range
For Each c In Range("F5:F42")
    If c.Value2 = "Expired" Then Call Mail_small_Text_Outlook(c.Offset(0, -3).Value2)
Next c
End Sub

第一个例程是由单击命令按钮触发的。它循环遍历 F5:F42 范围内的每个单元格。如果单元格具有 "Expired" 作为值，它会调用邮件例程，并将列 C 中包含的值传递给它（通过使用 F 列地址 -3 列）

Sub Mail_small_Text_Outlook(emailAddress As String)

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "Your certification has expired." & vbNewLine & _
              "Please contact an admin."

    On Error Resume Next
    With OutMail
        .To = emailAddress
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = strbody

        .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

邮件例程接受电子邮件地址作为参数，希望您会注意到它取代了您在 .To 行

上的通用 "email address.com"

请注意当前代码正在为每次需要发送电子邮件时创建一个新的Outlook实例，而不是关闭它。我认为您可以简单地使用 OutApp.Quit 行退出 Outlook，因此请尝试将其粘贴在 Mail_small_Text_Outlook 例程

的末尾

如果单元格包含单词 "expired"，请发送电子邮件

Send an email if the cell contains the word "expired"

excel

vba

excel-2016