使用公式查找满足特殊单元格内条件的电子邮件

时间:2017-04-19 06:24:36

标签: excel-vba email excel-formula vba excel

我正在开发一种能够通过电子邮件向不符合条件的人发送电子邮件的跟踪器。我有NAMES反映在第19行(H19:AE19具体;每个单元格列反映1个名称);第18行中的电子邮件相对于各自的名称;第20行中要满足的条件(如果空白则发送电子邮件;如果填充则移至下一个)。

其他信息:每个细节都嵌入了公式。只要某个下拉列表发生变化,它就会改变。

所以,代码在下面,我似乎无法让它工作:

Sub Test1()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

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

On Error GoTo cleanup


For Each cell In Rows(18).Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "?*@ntrs.com" And _
    LCase(cell.Offset(2).Value) = "" Then
        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .To = cell.Value
            .Subject = "Reminder"
            .Body = "Dear " & cell.Offset(1).Value _
                  & vbNewLine & vbNewLine & _
                    "Please contact us to discuss bringing " & _
                    "your account up to date"
            .Display
            .Send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
    End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

Thanks in advance!

1 个答案:

答案 0 :(得分:1)

猜一猜,你说

  

这些细节中的每一个都嵌入了公式

如果第18行中的电子邮件地址包含公式,则此行不会捕获它们:

  

For Each cell In Rows(18).Cells.SpecialCells(xlCellTypeConstants)

将其更改为以下内容可能会解决问题,并且在任何情况下都是优选的,因为您稍后会根据电子邮件模式检查字符串:

For Each cell In ActiveSheet.UsedRange.Rows(18).Cells

更好的是,指定包含这些数据的工作表,即如果其名称是" myEmails&#34 ;;做到这一点

For Each cell In Worksheets("myEmails").UsedRange.Rows(18).Cells