我正在开发一种能够通过电子邮件向不符合条件的人发送电子邮件的跟踪器。我有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!
答案 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