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

Question

当 F 列中的相应单元格包含文本"已过期"时，我想使用 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 = "[e-mail]"
.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 中的每个单元格中循环。如果单元格的值为"已过期"，它将调用邮件例程，并将 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行上的通用"电子邮件 address.com">

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