Excel 如果相应单元格中包含单词“QUOTE”，如何向特定收件人发送电子邮件；过期；？

我有一个电子邮件地址列表，但我只需要向相应手机中“过期”的个人发送电子邮件。单击按钮时，它将打开多个outlook窗口

这就是我到目前为止所做的：

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
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)
    
Set ws = Sheets("Sheet1")
 Set Rng = ws.Range(ws.Range("A1"), ws.Range("A" & Rows.Count).End(xlUp))
  
    For Each cell In Rng
           
    If cell.Value2 = "Expired" Then
      SendTo = SendTo & cell.Value & ";"
    End If
   Next
    
    strbody = "Hello," & vbNewLine & vbNewLine & _
              "You are receiving this email because your Wastewater Pathogens (Annual) is now expired or will expire within the next 30 days. Please sign up for the next available class in LMS. If you are unable to sign up in LMS, please contact Christa Scott." & vbNewLine & _
              "Thank you and have a nice day."

    On Error Resume Next
    With OutMail
        .To = SendTo
        .CC = ""
        .BCC = ""
        .Subject = "Expired Hazmat Right-to-Know Training - " & Date
        .Body = strbody

        .Display 'or .Send to automatically send email.
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

---

要从命令按钮运行代码，请调用它一次，并使用cell.Offset（，5）.Value2检查F列中的“expired”

选项显式
私有子命令按钮1_单击（）
呼叫邮件\u小型\u文本\u Outlook
端接头
子邮件\小型\文本\ Outlook（）
将ws设置为工作表
变暗rng As范围
暗淡单元格作为范围
Dim OutApp作为对象
将邮件变暗为对象
将strSendTo设置为字符串
像弦一样暗的链子
Set-OutApp=CreateObject（“Outlook.Application”）
Set-OutMail=OutApp.CreateItem（0）
设置ws=图纸（“图纸1”）
设置rng=ws.Range（ws.Range（“A1”）、ws.Range（“A”和Rows.Count）.End（xlUp））
对于rng中的每个单元
如果cell.Offset（，5）.Value2=“过期”，则
strSendTo=strSendTo&cell.Value&“；”
如果结束
下一个
strBody=“你好，”&vbNewLine&vbNewLine&_
“您收到此电子邮件是因为您的课程（年度）已过期或将在未来30天内过期。请注册LMS中的下一个可用课程。如果您无法注册LMS，请联系Christa Scott。”&vbNewLine&_
“谢谢你，祝你今天愉快。”
出错时继续下一步
发邮件
.To=strSendTo
.CC=“”
.BCC=“”
.Subject=“过期危险品知情权培训-”&日期
.车身=车身
.Display'或.Send可自动发送电子邮件。
以
错误转到0
发送邮件=无
设置应用程序=无
端接头

B列中的值是否“已过期”？代码是否有问题？F列中的值为“已过期”。然后在上的if语句中使用cell.Offset（，5）.value，而不是cell.Value2。虽然有效，但现在打开了太多outlook窗口。我的按钮代码在上面。这工作非常好。谢谢